x64下选择文件对话框

flydyt

请问有没有64位Windows下使用的OpenDialog代码。我这commondialog控件运行不了。api函数执行不对。不知道哪位有可运行的api函数做的OpenDialog。谢谢

marting

你使用什么语言开发？

flydyt

使用vba，32位下有一个，现在换到64位下好像执行有问题，对话框不显示。

newer

flydyt 发表于 2016-12-29 19:26

参考下这个帖子 http://bbs.xdcad.net/thread-705407-1-1.html

flydyt

好像明经通道上有一个解决办法，现在我被禁止发言，上不去。请哪位给看看。谢谢

flydyt

已解决，win7 x64 GetOpenFileName问题终于解决

xp时GetOpenFileName在vbs里正常，到win7 x64就不行了，没有弹出对话框，搜遍瞎度也没有，只发现一个老外在论坛的一堆回复中指出了问题的原因。
https://forums.autodesk.com/t5/v ... td-p/1726554/page/3
用户 Profex13 提到：
Besides all the PtrSafe and LongPtr changes to the Declare GetOpenFileName & OPENFILENAME type, you need to change the Len(udtStruct) to LenB(udtStruct).
AutoCAD 2014 is the first version to use VBA7, which is 64-bit, like AutoCAD.  Prior to this, VBA was 32-bit and PtrSafe and LongPtr/LongLong didn't exist.
因为用法变了。

'//The Win32 API Functions///
#If VBA7 Then
Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
#Else
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
#End If

'//The Structure
#If VBA7 Then
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long 'LongPtr
    lpfnHook As LongPtr
    lpTemplateName As String
End Type
#Else
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
#End If

qindong668

以下代码经测试在64 WIN7、AutoCAD 2016下可以使用：

'选择文件
Option Explicit


Private Declare PtrSafe Function ts_apiGetOpenFileName Lib "comdlg32.dll"  Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
Private Declare PtrSafe Function ts_apiGetSaveFileName Lib "comdlg32.dll"  Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
Private Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Private Type tsFileName
   lStructSize As Long
   hwndOwner As LongPtr
   hInstance As LongPtr
   strFilter As String
   strCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   strFile As String
   nMaxFile As Long
   strFileTitle As String
   nMaxFileTitle As Long
   strInitialDir As String
   strTitle As String
   flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   strDefExt As String
   lCustData As Long
   lpfnHook As LongPtr
   lpTemplateName As String
End Type

' Flag Constants
Private Const tscFNAllowMultiSelect = &H200
Private Const tscFNCreatePrompt = &H2000
Private Const tscFNExplorer = &H80000
Private Const tscFNExtensionDifferent = &H400
Private Const tscFNFileMustExist = &H1000
Private Const tscFNPathMustExist = &H800
Private Const tscFNNoValidate = &H100
Private Const tscFNHelpButton = &H10
Private Const tscFNHideReadOnly = &H4
Private Const tscFNLongNames = &H200000
Private Const tscFNNoLongNames = &H40000
Private Const tscFNNoChangeDir = &H8
Private Const tscFNReadOnly = &H1
Private Const tscFNOverwritePrompt = &H2
Private Const tscFNShareAware = &H4000
Private Const tscFNNoReadOnlyReturn = &H8000
Private Const tscFNNoDereferenceLinks = &H100000

Public Function tsGetFileFromUser( _
    Optional ByRef rlngflags As Long = 0&, _
    Optional ByVal strInitialDir As String = "", _
    Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
    Optional ByVal lngFilterIndex As Long = 1, _
    Optional ByVal strDefaultExt As String = "", _
    Optional ByVal strFileName As String = "", _
    Optional ByVal strDialogTitle As String = "", _
    Optional ByVal fOpenFile As Boolean = True) As Variant
'On Error GoTo tsGetFileFromUser_Err

    Dim tsFN As tsFileName
    Dim strFileTitle As String
    Dim fResult As Boolean


    ' Allocate string space for the returned strings.
    strFileName = Left(strFileName & String(256, 0), 256)
    strFileTitle = String(256, 0)


    ' Set up the data structure before you call the function
    With tsFN
        .lStructSize = LenB(tsFN)
        '.hwndOwner = Application.hWndAccessApp
        .strFilter = strFilter
        .nFilterIndex = lngFilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = strDialogTitle
        .flags = rlngflags
        .strDefExt = strDefaultExt
        .strInitialDir = strInitialDir
        .hInstance = 0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
        .lpfnHook = 0
    End With

    ' Call the function in the windows API
    If fOpenFile Then
        fResult = ts_apiGetOpenFileName(tsFN)
    Else
        fResult = ts_apiGetSaveFileName(tsFN)
    End If


    ' If the function call was successful, return the FileName chosen
    ' by the user. Otherwise return null. Note, the CancelError property
    ' used by the ActiveX Common Dialog control is not needed. If the
    ' user presses Cancel, this function will return Null.
    If fResult Then
        rlngflags = tsFN.flags
        tsGetFileFromUser = tsTrimNull(tsFN.strFile)
    Else
        tsGetFileFromUser = Null
    End If


'tsGetFileFromUser_End:
' On Error GoTo 0
' Exit Function


'tsGetFileFromUser_Err:
' Beep
' MsgBox Err.Description, , "Error: " & Err.Number _
' & " in function basBrowseFiles.tsGetFileFromUser"
' Resume tsGetFileFromUser_End


End Function


' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
On Error GoTo tsTrimNull_Err
    Dim I As Integer

    I = InStr(strItem, vbNullChar)
    If I > 0 Then
        tsTrimNull = Left(strItem, I - 1)
    Else
        tsTrimNull = strItem
    End If

tsTrimNull_End:
    On Error GoTo 0
    Exit Function


tsTrimNull_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
    & " in function basBrowseFiles.tsTrimNull"
    Resume tsTrimNull_End


End Function

’使用示例
'--------------------------------------------------------------------------
' Project      : tsDeveloperTools
' Description  : An example of how you can call tsGetFileFromUser()
' Calls        :
' Accepts      :
' Returns      :
' Written By   : Carl Tribble
' Date Created : 05/04/1999 11:19:41 AM
' Rev. History :
' Comments     : This is provided merely as an example to the programmer
'                It may be safely deleted from production code.
'--------------------------------------------------------------------------


Public Sub tsGetFileFromUserTest()
On Error GoTo tsGetFileFromUserTest_Err

    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant


'   strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
'    & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
    strFilter = "All Files (*.*)" & vbNullChar & "*.*"


    lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly

    varFileName = tsGetFileFromUser( _
    fOpenFile:=True, _
    strFilter:=strFilter, _
    rlngflags:=lngFlags, _
    strDialogTitle:="GetFileFromUser Test (Please choose a file)")

    If IsNull(varFileName) Then
        Debug.Print "User pressed 'Cancel'."
    Else
        Debug.Print varFileName
        'Forms![Form1]![Text1] = varFileName
    End If


    If varFileName <> "" Then MsgBox "You selected the '" & varFileName & "' file.", vbInformation


tsGetFileFromUserTest_End:
    On Error GoTo 0
    Exit Sub


tsGetFileFromUserTest_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
     & " in sub basBrowseFiles.tsGetFileFromUserTest"
    Resume tsGetFileFromUserTest_End


End Sub

'原文在：(http://blog.sina.com.cn/s/blog_55fc7c2f0101mb4t.html)