AutoCAD VBA to Launch FileDialog with Windows API throws Error 449 "Argument Not Optional"

Question

I have a custom VBA program that loops through a bunch of AutoCAD files and extracts data from them. As of right now I'm using a separate Excel file to select multiple .dwg files via Excel FileDialog and I'd like to have that file selection be done in AutoCAD instead.

I've found an API Function on an AutoCAD help forum but can't get it to work. It's titled "FileDialogs."

The first block of code is my primary module, the second block is the FileDialogs class module I was given.

I've gone through the FileDialogs Class Module that references the Windows API and added "PtrSafe" to the functions and changed all the "Long"s to "LongPtr."

-EDIT- I've updated the code to my semi-working code. It launches a file window but doesn't return a list of selected drawings, so, idk. Good 'nuff?

'THIS IS MY 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

'THIS IS THE CLASS MODULE I WAS GIVEN ON THE AUTOCAD FORUM
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 String

    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

Look at the `ShowOpen` method in the Class. It shows the expected arguments. — Brian M Stafford, May 30 '19 at 13:00
The arguments for ShowOpen, strDir, strTitle, and strFilter are defined in the "Class_Initialize" sub, so when ShowOpen is called in my primary module it should launch using those variables as defined in Class_Initialize. — John, May 30 '19 at 13:11
Nonetheless, the arguments must be passed. Another option is to modify the method to not take arguments. — Brian M Stafford, May 30 '19 at 13:21
I've edited the error line to say: strFileName = objFile.ShowOpen(strDir, strFilter, strTitle) Now the error isn't being thrown but the FileDialog isn't launching. No errors, but it's also not actually working. — John, May 30 '19 at 13:40
Your code is working correctly, and returning the selected files. If you inspect `strFileName` when stepping through the code you will see what I mean. The issue is `strFileName` contains a null-terminated list of files, and the first piece of information is the folder from where you selected the files. The MsgBox line of code will stop at the first null it encounters. — Brian M Stafford, Jun 04 '19 at 16:08
That was correct. I replaced the nulls with another character ("|" in testing, not sure for when I roll it out), and it reads the whole thing now. — John, Jun 10 '19 at 17:30
Would you have any suggestions on how to get around the character limit being 255? I need to cycle through a large list of drawings and can't do that with a character limit of 255 — John, Jun 10 '19 at 17:42
The value of 255 is hard-coded into the ShowOpen method. You could change these values, but I'm not sure what the max value would be. — Brian M Stafford, Jun 10 '19 at 18:04
I've changed the max length from 255 to 1000 and 99999 and all it did was cut the value off at the same limit. I've also changed ShowOpen to output a variant to see if that did anything, and it didn't. Not sure what else to try. — John, Jun 10 '19 at 18:39

AutoCAD VBA to Launch FileDialog with Windows API throws Error 449 "Argument Not Optional"

0 Answers0