×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Method to Set the Path of the File Directory

Method to Set the Path of the File Directory

Method to Set the Path of the File Directory

(OP)
Anyone off hand know the VBA code to set the directory path so that the directory window opens up for a user to select the path?

Also, is there an input box that will take multiple entiries like a tabulated list?

RE: Method to Set the Path of the File Directory

Spurs - I'm not sure I understand what you are asking for.  Can you clarify what you are trying to do?

RE: Method to Set the Path of the File Directory

(OP)
I am trying to select a directory using the mouse (without having to type in manually the full path) where I am going to store hundreds of files that the macro will create.

RE: Method to Set the Path of the File Directory

What about creating a macro to do that?  Wouldn't that generate the VBA code you need?

RE: Method to Set the Path of the File Directory

Hi, Spurs:

I am not sure about VBA.  But if you use VB or VB.net, you will use MS common dialog control to browse for that.

Alex

RE: Method to Set the Path of the File Directory

This may be one of the most useful routines you will ever find for SolidWorks.  Thanks to Rocheey for posting this.


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

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

'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.


' 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 --------------




RE: Method to Set the Path of the File Directory

Maybe I'm not clear. If you want a folder to save your macros when they are created, go to File/Options/FIle Locations/Macros and browse to the file location. They will be saved there auto when created.

Chris
Sr. Mechanical Designer, CAD
SolidWorks 05 SP3.1 / PDMWorks 05
ctopher's home site (updated 06-21-05)
FAQ559-1100
FAQ559-716

RE: Method to Set the Path of the File Directory

(OP)
What I am trying to do is while the macro is running, the macro will prompt me to select a folder location where to save the files created by the macro.

Any suggestions?

RE: Method to Set the Path of the File Directory

The BrowseForFolder function in the code I posted will do this.  

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources