(Found on a MS page)
The following script will display a BrowseForFolder - dialog:
Option Explicit
' BROWSEINFO ulFlags values:
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_EDITBOX = &H10 ' Add an editbox to the dialog
Public Const BIF_VALIDATE = &H20 ' insist on valid result (or CANCEL)
Public Const BIF_NEWDIALOGSTYLE = &H40 ' Use the new dialog layout with the ability to resize
' Caller needs to call OleInitialize() before using this API
Public Const BIF_USENEWUI = BIF_NEWDIALOGSTYLE Or BIF_EDITBOX
Public Const BIF_BROWSEINCLUDEURLS = &H80 ' Allow URLs to be displayed or entered. (Requires BIF_USENEWUI)
Public Const BIF_UAHINT = &H100 ' Add a UA hint to the dialog, in place of the edit box. May not be combined with BIF_EDITBOX
Public Const BIF_NONEWFOLDERBUTTON = &H200 ' Do not add the "New Folder" button to the dialog. Only applicable with BIF_NEWDIALOGSTYLE.
Public Const BIF_NOTRANSLATETARGETS = &H400 ' don't traverse target as shortcut
Public Const BIF_BROWSEINCLUDEFILES = &H4000 ' Browsing for Everything
Public Const BIF_SHAREABLE = &H8000 ' sharable resources displayed (remote shares, requires BIF_USENEWUI)
'############################# ShowOpenFolder #################################
'This function creates OpenFolder Dialog box in VbScript
'Designed by Rajendra Khope
'taken from the ms 'Shell.BrowseForFolder method' page
'https://msdn.microsoft.com/de-de/library/windows/desktop/bb774065%28v=vs.85%29.aspx
Public Function ShowOpenFolder()
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = BIF_NEWDIALOGSTYLE Or BIF_UAHINT ' 0 'bif-flags
Dim objShell
Dim objFolder 'returned path
Dim objFolderItem
Dim strPath 'root path
Dim objPath
'Refer this Link http://msdn.microsoft.com/en-us/library/bb774085(VS.85).aspx
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
'This for all - http://msdn.microsoft.com/en-us/library/ff521729(v=VS.85).aspx
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select folder to Save File:", OPTIONS, strPath)
' Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select folder to Save File:", OPTIONS, CATIA.ActiveDocument.Path)
If objFolder Is Nothing Then
ShowOpenFolder = "C:"
Exit Function
End If
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
ShowOpenFolder = objPath
Set objShell = Nothing
End Function
'######################################################################
The dialog looks like this:
