API VBA: Open Dialog

Sure. Once you have a userform in your SW Macro, the menu selection Tools - Additional Controls should be enabled. This brings up a list, from which you can select Microsoft Common Dialog Control. This may not be installed by the VBA, but if you have VB on your computer, you've got it and can use it here.

Regards, Brenda

----------------------------------------------- Brenda D. Bosley, PE CustomSolids

i dont know about vba because its a chopped up version of visual basic. but vb6.0 and later. you can create a your own open dialog boxs. this is not a part of solidworks api but is a part of visual basic.

Common dialogs can be created as well by calling Windows API functions. For open dialog box, there is a function GetOpenFileName. In VB you would need to declare that function like

Declare Function GetOpenFileName Lib "Comdlg32" (lpofn As OPENFILENAME) As Boolean

You would also need to declare OPENFILENAME structure as defined in WIN api help, like

Type OPENFILENAME lStructSize as Long hwndOwner as Long ... etc End Type

Showing Open dialog box would need the following steps:

- Create an instance of OPENFILENAME structure

- Fill in the required values

- Call OpenFileName function

- Read the selected file name and path from the structure

More details can be found by seacrhing MSDN, see msdn.microsoft.com. I don't know, however, if that can be done in VBA.

-h-

Here is a module I use for such things. It works in VB and VBA. It has file open, file save, and browse for folder dialogs. There is a "Sub Main" that demos some of the features, run that to get a feel for it. The "OpenFiles" routine allows for setting a non-local directory as a seed directory, as well as allowing/disallowing multiple file selections thru the dialog.

' --- snip --------- snip -------------- snip --------------

' CommonDialog.Bas ' written by rocheey for anyone who wants it

' API implementation of Common Dialog ' works in VBA and VB ' ' Contains 3 main routines: ' "SaveFile" Pops up File Save Dialog ' "OpenFiles" File Open Dialog ' "BrowseForFolder" Self explanatory

' Run "Main" subroutine to see implementations of these routines

Const OFN_ALLOWMULTISELECT = &H200 Const OFN_CREATEPROMPT = &H2000 Const OFN_ENABLEHOOK = &H20 Const OFN_ENABLETEMPLATE = &H40 Const OFN_ENABLETEMPLATEHANDLE = &H80 Const OFN_EXPLORER = &H80000 Const OFN_EXTENSIONDIFFERENT = &H400 Const OFN_FILEMUSTEXIST = &H1000 Const OFN_HIDEREADONLY = &H4 Const OFN_LONGNAMES = &H200000 Const OFN_NOCHANGEDIR = &H8 Const OFN_NODEREFERENCELINKS = &H100000 Const OFN_NOLONGNAMES = &H40000 Const OFN_NONETWORKBUTTON = &H20000 Const OFN_NOREADONLYRETURN = &H8000 Const OFN_NOTESTFILECREATE = &H10000 Const OFN_NOVALIDATE = &H100 Const OFN_OVERWRITEPROMPT = &H2 Const OFN_PATHMUSTEXIST = &H800 Const OFN_READONLY = &H1 Const OFN_SHAREAWARE = &H4000 Const OFN_SHAREFALLTHROUGH = 2 Const OFN_SHAREWARN = 0 Const OFN_SHARENOWARN = 1 Const OFN_SHOWHELP = &H10 Const OFS_MAXPATHNAME = 128

Const BIF_RETURNONLYFSDIRS = &H1 Const BIF_DONTGOBELOWDOMAIN = &H2 Const BIF_STATUSTEXT = &H4 Const BIF_RETURNFSANCESTORS = &H8 Const BIF_BROWSEFORCOMPUTER = &H1000 Const BIF_BROWSEFORPRINTER = &H2000 Const MAX_PATH = 260

Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or OFN_HIDEREADONLY Or OFN_LONGNAMES Or OFN_CREATEPROMPT Or OFN_NODEREFERENCELINKS Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY Const OFS_MULTIFILE_OPEN_FLAGS = OFN_ALLOWMULTISELECT Or OFN_HIDEREADONLY Or OFN_EXPLORER Or OFN_LONGNAMES Or OFN_CREATEPROMPT Or OFN_NODEREFERENCELINKS

Type OPENFILENAME nStructSize As Long hwndOwner As Long hInstance As Long sFilter As String sCustomFilter As String nCustFilterSize As Long nFilterIndex As Long sFile As String nFileSize As Long sFileTitle As String nTitleSize As Long sInitDir As String sDlgTitle As String flags As Long nFileOffset As Integer nFileExt As Integer sDefFileExt As String nCustDataSize As Long fnHook As Long sTemplateName As String End Type

Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type

Dim FileInfo As OPENFILENAME

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) Declare Function SetCurrentDirectoryA Lib "Kernel32" (ByVal lpszCurDir As String) As Long Declare Function GetDesktopWindow Lib "user32" () As Long

Private Sub Main()

msg$ = "First, call up the file open dialog." & vbCrLf & vbCrLf msg$ = msg$ & "We we allow multiple file selections," & vbCrLf msg$ = msg$ & "will seed the current directory to 'C:'" & vbCrLf msg$ = msg$ & "and filter for text files." & vbCrLf & vbCrLf MsgBox msg$, 32, "File Open Test call" Dim retFiles As Variant ' call the dialog retFiles = OpenFiles("*.txt", "Text Files", "Open Files Demo", True, "C:\") ' check the return If IsEmpty(retFiles) Then MsgBox "No File(s) Selected.", 32, "End of File Open Demo" Else msg$ = "You selected the following files:" & vbCrLf & vbCrLf ' Loop thru all the returned files For I% = 0 To UBound(retFiles) msg$ = msg$ & retFiles(I%) & vbCrLf Next I% msg$ = msg$ & vbCrLf MsgBox msg$, 32, "End of File Open Demo" End If

' Now demo the browse for folder call msg$ = "Now for the Browse for Folder routine." & vbCrLf & vbCrLf msg$ = msg$ & "You will be prompted to type in the " & vbCrLf msg$ = msg$ & "Caption for the Dialog. This demo will" & vbCrLf msg$ = msg$ & "trim the Caption to 32 characters." & vbCrLf MsgBox msg$, 32, "Browse for Folder Demo" Dim retStr As String Const MyCaption As String = "My Caption" retStr = InputBox("Type in a name for the dialog", "Browse for Folder demo", MyCaption)

If retStr = "" Then retStr = MyCaption Else retStr = Left$(retStr,

32) ' Call up the browse for folder dialog Dim retPath As String retPath = BrowseForFolder(retStr) ' check the return path If retPath = "" Then MsgBox "No Folder selected." & vbCrLf & vbCrLf, 32, "Browse for Folder Demo" Else msg$ = "You selected the following folder : " & vbCrLf & vbCrLf msg$ = msg$ & retPath & vbCrLf & vbCrLf MsgBox msg$, 32, "Browse for Folder Demo" End If

End Sub

' +--------------------------------------------------------------------+ ' | -= Main sub to call File SAVE Dialog =- | ' | | ' | Parameters: FileName$ is a variable that the name of the SAVED | ' | file name is returned in. You do NOT have to pass | ' | a filename to this routine, one is returned. Note | ' | that the Win API checks for, and prompts, if the | ' | filename already exists. | ' | | ' | FileExt$ is the file extension name you wish the | ' | Dialog box to use, for default extension, file | ' | listings, and availablity innthe drop-down "file | ' | type" box. | ' | | ' | FileDesc$ is a descriptive name for the File Name | ' | Extension, used to describe the filetype in the drop | ' | down type box. | ' | | ' +--------------------------------------------------------------------+ Function SaveFile(FileName$, FileExt$, FileDesc$, WinTitle$) As String Dim strCurName As String Dim strFill, strFilter As String Dim lngReturn, ShortSize As Long On Error GoTo Err_Control strCurName = FileName$ strFill = Chr(0) FileInfo.nStructSize = Len(FileInfo) FileInfo.hwndOwner = GetDesktopWindow 'This section is for the filter drop down list strFilter = FileDesc$ & strFill & FileExt$ & strFill strFilter = strFilter & "All Files" & strFill & "*.*" & strFill & strFill FileInfo.sFilter = strFilter 'This is the default information for the dialog FileInfo.sFile = FileName$ & Space$(1024) & strFill FileInfo.nFileSize = Len(FileInfo.sFile) FileInfo.sDefFileExt = FileExt$ FileInfo.sFileTitle = Space(512) FileInfo.nTitleSize = Len(FileInfo.sFileTitle) FileInfo.sInitDir = CurDir FileInfo.sDlgTitle = WinTitle$ ' use below to call save dialog FileInfo.flags = OFS_FILE_SAVE_FLAGS lngReturn = GetSaveFileName(FileInfo) If lngReturn Then SaveFile = FileInfo.sFile End If On Error GoTo 0 Exit Function Err_Control: 'Just get out, to many things to account for MsgBox Err.Description, vbCritical, "Too many errors, aborting" End Function

' +--------------------------------------------------------------------+ ' | -= OpenFiles =- | ' | | ' | Parameters:FileExt is the file extension name you wish the | ' | Dialog box to use, for default extension, file | ' | listings, and availablity in the drop-down "file | ' | type" box. | ' | | ' | FileDesc is a descriptive name for the File Name | ' | Extension, used to describe the filetype in the drop | ' | down type box. | ' | | ' | WindowCaption is the string you wish to display | ' | in the dialog title bar | ' | | ' | AllowMulti is a boolean describing whether you wish to | ' | allow multiple files to be selected | ' | | ' | StartDir Is a string describing the Folder name in | ' | which you want the dialog to be displaying on open. | ' | | ' | Returns: | ' | a variant safearray of the qualified filespec/pathspecs | ' | If user does not select anything, variant is EMPTY. | ' | If user selects one file, it will be UBOUND(0) | ' | | ' +--------------------------------------------------------------------+ Function OpenFiles(FileExt As String, FileDesc As String, WindowCaption As String, AllowMulti As Boolean, StartDir As String) As Variant

' filedesc=File description for drop down box ' WindowCaption = caption of the file window ' parent hwnd - usew dewsktophwnd?

Dim strCurName As String Dim lngReturn As Long Dim strFill As String Dim strFilter As String Dim CurrentDir As String Dim strReturnFiles As String Dim varReturnFiles As Variant On Error GoTo Err_Control strCurName = "" CurrentDir = CurDir ' store current directory If StartDir > "" Then SetCurDir StartDir ' set current directory to passed dir End If strFill = Chr(0) FileInfo.nStructSize = Len(FileInfo) FileInfo.hwndOwner = GetDesktopWindow ' return hwnd of desktop 'This section is for the filter drop down list strFilter = FileDesc & strFill & FileExt & strFill strFilter = strFilter & "All Files" & strFill & "*.*" & strFill & strFill FileInfo.sFilter = strFilter 'This is the default information for the dialog FileInfo.sFile = strCurName & Space$(1024) & strFill FileInfo.nFileSize = Len(FileInfo.sFile) FileInfo.sDefFileExt = FileExt FileInfo.sFileTitle = Space(512) FileInfo.nTitleSize = Len(FileInfo.sFileTitle) FileInfo.sInitDir = CurDir FileInfo.sDlgTitle = WindowCaption ' use below to call open dialog ' optionally use single or multiple selection open flags If AllowMulti = True Then FileInfo.flags = OFS_MULTIFILE_OPEN_FLAGS Else FileInfo.flags = OFS_FILE_OPEN_FLAGS End If lngReturn = GetOpenFileName(FileInfo) ChDir CurrentDir ' reset current directory If lngReturn Then ' all went well, see if we have multi files to parse strReturnFiles = FileInfo.sFile If AllowMulti = True Then varReturnFiles = SeedFileList(strReturnFiles) Else varReturnFiles = Array(strReturnFiles) End If Else Exit Function End If

OpenFiles = varReturnFiles

On Error GoTo 0 Exit Function

Err_Control: 'Just get out, to many things to account for MsgBox Err.Description, vbCritical, "Too many errors, aborting" Err.Clear End Function

' +--------------------------------------------------------------------+ ' | -= BrowseForFolder =- | ' | | ' | Pops up Browse For Folder dialog | ' | | ' | Parameters: WindowTitle: Caption you wish to see in the dialog | ' | | ' | Returns: Path Name to folder if selected; empty string if | ' | user cancels. | ' +--------------------------------------------------------------------+ Function BrowseForFolder(WindowTitle As String) As String ' call the Browse for folders dialog, returns Pathname Dim bi As BROWSEINFO Dim pidl As Long Dim path As String Dim pos As Integer Dim pathRet As String Dim lastChar As String bi.hOwner = GetDesktopWindow ' get hwnd bi.pidlRoot = 0 'Pointer to the item identifier list bi.lpszTitle = WindowTitle 'message to be displayed in the Browse dialog bi.ulFlags = BIF_RETURNONLYFSDIRS 'the type of folder to return. pidl = SHBrowseForFolder(bi) 'show the browse for folders dialog path = Space$(MAX_PATH) 'parse the user's returned folder selection contained in pidl If SHGetPathFromIDList(ByVal pidl, ByVal path) Then pos = InStr(path, Chr$(0)) pathRet = Left$(path, pos - 1) lastChar = Right$(pathRet, 1) If lastChar "/" And lastChar "\" Then pathRet = pathRet & "\" BrowseForFolder = pathRet End If Call CoTaskMemFree(pidl) End Function

Function SetCurDir(NetPath As String) As Boolean ' uses API call to set CurDir for file open/save ' (VB only allows local dir for CurDir)

Dim FName As String, CDir As String CDir = CurDir$ SetCurDir = SetCurrentDirectoryA(NetPath)

End Function

Function SeedFileList(nullStr As String) As Variant ' processes return from "OpenFiles" routine, when multiple files are selected ' Win API returns a string embedded with many files, ' each terminated with an ascii zero. Takes this string and returns ' a varaint safearray of fully qualified Filespecs (or empty if none) Dim strLoc() As Integer Dim strCounter As Integer Dim FileCounter As Integer Dim FileSpec() As String Dim strLen%, I%, Char$, NextSeekStartPos%, SeekLength% Dim LastSeekPos%, NextSeekEndPos%, ThisStr$, FilePath$, SwapStr$

If Len(nullStr) = 0 Then Exit Function strCounter = -1 FileCounter = -1 strLen% = Len(nullStr) For I% = 1 To strLen% Char$ = Mid$(nullStr, I%, 1) If Char$ = Chr$(0) Then strCounter = strCounter + 1 ReDim Preserve strLoc(0 To strCounter) As Integer strLoc(strCounter) = I% End If Next I% ' now Loop thru and find where 2 ascii nulls are next to each other. thats where the string 'array' ends If strCounter > 1 Then ' if only 2, then only one string For I% = 0 To (strCounter - 1) If strLoc(I%) + 1 = strLoc(I% + 1) Then ' byte locations next to eacxh other strCounter = I% ' end at the first of the 2 matching null sets Exit For End If Next I% Else strCounter = 0 ' set to 0-based "1" index End If ' Now that we've changed the counter, lets go back and get the strings LastSeekPos% = 0 ' initialize last found location For I% = 0 To strCounter NextSeekStartPos% = LastSeekPos% + 1 NextSeekEndPos% = strLoc(I%) - 1 SeekLength% = NextSeekEndPos% - NextSeekStartPos% + 1 ThisStr$ = Mid$(nullStr, NextSeekStartPos%, SeekLength%) If I% = 0 Then ' if first entry If strCounter > 0 Then ' and there is more than one file, then first entry is the path, dont add to list FilePath$ = ThisStr$ If Right(FilePath$, 1) "\" Then FilePath$ = FilePath$ & "\" ' append dir char Else ' first of one entry; add it to the list FileCounter = FileCounter + 1 ReDim Preserve FileSpec(0 To FileCounter) As String FileSpec(FileCounter) = ThisStr$ End If Else ' Second or Greater entry, PREpend pathspec ThisStr$ = FilePath$ & ThisStr$ FileCounter = FileCounter + 1 ReDim Preserve FileSpec(0 To FileCounter) As String FileSpec(FileCounter) = ThisStr$ End If LastSeekPos% = strLoc(I%) Next I% ' Now build an output string (variant safearray), nulls removed If FileCounter > -1 Then If FileCounter > 0 Then ' reverse first and last entries (always comes back crooked!) SwapStr$ = FileSpec(FileCounter) FileSpec(FileCounter) = FileSpec(0) FileSpec(0) = SwapStr$ End If SeedFileList = FileSpec() End If

End Function

' --- snip --------- snip -------------- snip --------------

I will try that out, thank you.

Corey Scheich