Класс FileDialogs, который вызывает Windows API в AutoCAD через VBA, не будет возвращать несколько файлов - PullRequest
0 голосов
/ 31 мая 2019

У меня есть модуль класса FileDialogs, который вызывается с другим кодом, который запускает проводник и позволяет мне выбрать один или несколько файлов.

На данный момент, если я выбираю один файл, он возвращает полное имя файла (путь и имя файла), как и должно быть, но если я выбираю несколько файлов, он возвращает только путь к файлам.

Насколько я понимаю, он должен возвращать путь и имя файла 1, пространство, имя файла 2 и т. Д. (Например, "M: \ Folder \ File01.dwg File02.dwg File03.dwg"), но вместо этого он возвращает только путь (например, «M: \ Folder»).

'PRIMARY MODULE
Public Sub OpenFile()

    Set objFile = New FileDialogs

    Dim initpath As String
    Dim initfilter As String

    Dim inittitle As String

    initpath = ThisDrawing.Path & "\"
    'initfilter = "Drawing Files (*.dwg)|*.dwg"
    inittitle = "Select Files"

    'objFile.OwnerHwnd = ThisDrawing.Hwnd
    'objFile.title = "Select Drawings"
    objFile.MultiSelect = True
    'objFile.Filter = initfilter
    'objFile.StartInDir = initpath

    strFileName = objFile.ShowOpen(initpath, initfilter, inittitle)

    If Not strFileName = vbNullString Then
        MsgBox strFileName
    End If

    Set objFile = Nothing

End Sub
'CLASS MODULE, FILEDIALOGS
Option Explicit

'//The Win32 API Functions///
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (OFN As OPENFILENAME) As Boolean

Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (OFN As OPENFILENAME) As Boolean

Private Declare PtrSafe Function FindWindow Lib "user32" _
    Alias "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr

'//A few of the available Flags///
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_ALLOWMULTISELECT = &H200
'This one keeps your dialog from turning into
'A browse by folder dialog if multiselect is true!
'Not sure what I mean? Remove it from the flags
'In the "ShowOpen Open" & "ShowOpen Save" methods.
Private Const OFN_EXPLORER As Long = &H80000
'//The Structure
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
    lpfnHook As LongPtr
    lpTemplateName As String
End Type

Private lngHwnd As LongPtr
Public strFilter As String
Public strTitle As String
Public strDir As String
Private blnHideReadOnly As Boolean
Private blnAllowMulti As Boolean
Private blnMustExist As Boolean

Private Sub Class_Initialize()
    'Set default values when
    'class is first created
    strDir = Application.ActiveDocument.Path & "\"
    strTitle = "Select Files"
    'strFilter = "Drawing Files" & Chr$(0) & "*.dwg" & Chr$(0)

    lngHwnd = FindWindow(vbNullString, Application.Caption)
    'None of the flags are set here!
End Sub

Public Function FindUserForm(objForm As UserForm) As LongPtr
    Dim lngTemp As LongPtr
    Dim strCaption As String
    strCaption = objForm.Caption
    lngTemp = FindWindow(vbNullString, strCaption)

    If lngTemp <> 0 Then
        FindUserForm = lngTemp
    End If
End Function

Public Property Let OwnerHwnd(ByVal WindowHandle As LongPtr)
    '//FOR YOU TODO//
    'Use the API to validate this handle
    lngHwnd = WindowHandle
    'This value is set at startup to the handle of the
    'AutoCAD Application window, if you want the owner
    'to be a user form you will need to obtain its
    'Handle by using the "FindUserForm" function in
    'This class.
End Property

Public Property Get OwnerHwnd() As LongPtr
    OwnerHwnd = lngHwnd
End Property

Public Property Let title(ByVal Caption As String)
    'strTitle = "Select Files"
End Property

Public Property Get title() As String
    'title = strTitle
End Property

Public Property Let Filter(ByVal FilterString As String)
    'Filters change the type of files that are
    'displayed in the dialog. I have designed this
    'validation to use the same filter format the
    'Common dialog OCX uses:
    '"All Files (*.*)|*.*"
    Dim intPos As Integer

    Do While InStr(FilterString, "|") > 0
        intPos = InStr(FilterString, "|")
        If intPos > 0 Then
            FilterString = Left$(FilterString, intPos - 1) _
            & Chr$(0) & Right$(FilterString, _
            Len(FilterString) - intPos)
        End If
    Loop

    If Right$(FilterString, 2) <> Chr$(0) & Chr$(0) Then
        FilterString = FilterString & Chr$(0)
    End If

    'strFilter = FilterString
End Property

Public Property Get Filter() As String
    'Here we reverse the process and return
    'the Filter in the same format the it was
    'entered
    Dim intPos As Integer
    Dim strTemp As String
    strTemp = strFilter

    Do While InStr(strTemp, Chr$(0)) > 0
        intPos = InStr(strTemp, Chr$(0))
        If intPos > 0 Then
            strTemp = Left$(strTemp, intPos - 1) & "|" & Right$(strTemp, _
            Len(strTemp) - intPos)
        End If
    Loop

    If Right$(strTemp, 1) = "|" Then
        strTemp = Left$(strTemp, Len(strTemp) - 1)
    End If

    Filter = strTemp
End Property

Public Property Let StartInDir(ByVal strFolder As String)
    'Sets the directory the dialog displays when called
    If Len(Dir(strFolder)) > 0 Then
        strDir = strFolder
    Else
        Err.Raise 514, "FileDialog", "Invalid Initial Directory"
    End If
End Property

Public Property Let HideReadOnly(ByVal blnVal As Boolean)
    blnHideReadOnly = blnVal
End Property

Public Property Let MultiSelect(ByVal blnVal As Boolean)
    'allow users to select more than one file using
    'The Shift or CTRL keys during selection
    blnAllowMulti = True
End Property

Public Property Let FileMustExist(ByVal blnVal As Boolean)
    blnMustExist = blnVal
End Property

'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File open dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@

Function thAddFilterItem(ByVal strFilter As String, ByVal strDescription As String, Optional ByVal varItem As Variant) As String

    If IsMissing(varItem) Then varItem = "*.*"
    thAddFilterItem = strFilter & strDescription & vbNullChar & varItem & vbNullChar

End Function

Public Function ShowOpen(ByVal strDir As String, ByVal strFilter As String, ByVal strTitle As String) As Variant

    Dim strTemp As String
    strFilter = thAddFilterItem(strFilter, "Drawing Files (*.dwg)", "*.dwg")

    Dim udtStruct As OPENFILENAME

    With udtStruct
        .lStructSize = LenB(udtStruct)
        'Use our private variable
        .hwndOwner = lngHwnd
        'Use our private variable
        .lpstrFilter = strFilter
        .lpstrFile = Space$(254)
        .nMaxFile = 255
        .lpstrFileTitle = Space$(254)
        .nMaxFileTitle = 255
        'Use our private variable
        .lpstrInitialDir = strDir
        'Use our private variable
        .lpstrTitle = strTitle
        ' udtStruct.lpstrCustomFilter = "*.*"
        'Ok, here we test our booleans to
        'set the flag
    End With

    If blnHideReadOnly And blnAllowMulti And blnMustExist Then
        udtStruct.flags = OFN_HIDEREADONLY Or _
        OFN_ALLOWMULTISELECT Or OFN_EXPLORER Or OFN_FILEMUSTEXIST
    ElseIf blnHideReadOnly And blnAllowMulti Then
        udtStruct.flags = OFN_ALLOWMULTISELECT _
        Or OFN_EXPLORER Or OFN_HIDEREADONLY
    ElseIf blnHideReadOnly And blnMustExist Then
        udtStruct.flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
    ElseIf blnAllowMulti And blnMustExist Then
        udtStruct.flags = OFN_ALLOWMULTISELECT Or _
        OFN_EXPLORER Or OFN_FILEMUSTEXIST
    ElseIf blnHideReadOnly Then
        udtStruct.flags = OFN_HIDEREADONLY
    ElseIf blnAllowMulti Then
        udtStruct.flags = OFN_ALLOWMULTISELECT _
        Or OFN_EXPLORER
    ElseIf blnMustExist Then
        udtStruct.flags = OFN_FILEMUSTEXIST
    End If

    If GetOpenFileName(udtStruct) Then
        strTemp = (Trim(udtStruct.lpstrFile))
        ShowOpen = Mid(strTemp, 1, Len(strTemp) - 1)
    End If

End Function

'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File Save dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
Public Function ShowSave(ByVal strDir As String, ByVal strFilter, ByVal strTitle) As String

    Dim strTemp As String
    Dim udtStruct As OPENFILENAME
    udtStruct.lStructSize = LenB(udtStruct)
    'Use our private variable
    udtStruct.hwndOwner = lngHwnd
    'Use our private variable
    udtStruct.lpstrFilter = strFilter
    udtStruct.lpstrFile = Space$(254)
    udtStruct.nMaxFile = 255
    udtStruct.lpstrFileTitle = Space$(254)
    udtStruct.nMaxFileTitle = 255
    'Use our private variable
    udtStruct.lpstrInitialDir = strDir
    'Use our private variable
    udtStruct.lpstrTitle = strTitle
    If blnMustExist Then
        udtStruct.flags = OFN_FILEMUSTEXIST
    End If

    If GetSaveFileName(udtStruct) Then
        strTemp = (Trim(udtStruct.lpstrFile))
        ShowSave = Mid(strTemp, 1, Len(strTemp) - 1)
    End If

End Function

Function GetXLSFile(ByVal strDir As String, ByVal strTitle As String)
   ' strTitle = "Select Excel File"
    Dim strFilter As String ' , strTitle As String
    Dim lngFlags As LongPtr, filestring
    strFilter = thAddFilterItem(strFilter, "Excel File (*.xls)", "*.xls")
    GetXLSFile = ShowOpen(strDir, strFilter, strTitle)
End Function

Function GetDWGFile(ByVal strDir As String, ByVal strTitle As String)
   ' strTitle = "Select Drawing File"
    Dim strFilter As String ' , strTitle As String
    Dim lngFlags As LongPtr, filestring
    strFilter = thAddFilterItem(strFilter, "DWG File (*.dwg)", "*.dwg")
    GetDWGFile = ShowOpen(strDir, strFilter, strTitle)
End Function

Function SaveFile() '
    Dim strTitle As String
    Dim strDir As String
    Dim strFilter As String ' , strTitle As String
    Dim lngFlags As LongPtr, filestring
    strDir = "c:\"
    strTitle = "Save File"
    strFilter = thAddFilterItem(strFilter, "txt File (*.txt)", "*.txt")
    'SaveFile = ShowSave(strDir, strFilter, strTitle)
End Function

Повторюсь, моя проблема в том, что при выборе нескольких файлов он возвращает только путь (например, "M: \ Folder"), но не любое из фактических имен файлов, а это то, что мне действительно нужно.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...