Can I use code to browse a dialog to select folder?
Printable View
Can I use code to browse a dialog to select folder?
From Matt Gates
In a module:
VB Code:
Option Explicit Private Const MAX_PATH = 260 Public Enum browseInfoFlags BIF_NONE = 0 ' No Flags BIF_RETURNONLYFSDIRS = &H1& ' For finding a folder to start document searching BIF_DONTGOBELOWDOMAIN = &H2& ' For starting the Find Computer BIF_STATUSTEXT = &H4& BIF_RETURNFSANCESTORS = &H8& BIF_EDITBOX = &H10& BIF_VALIDATE = &H20& ' insist on valid result (or CANCEL) BIF_BROWSEFORCOMPUTER = &H1000& ' Browsing for Computers. BIF_BROWSEFORPRINTER = &H2000& ' Browsing for Printers BIF_BROWSEINCLUDEFILES = &H4000& ' Browsing for Everything End Enum Private Type BROWSEINFO hWndOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As browseInfoFlags lpfn As Long lParam As Long iImage As Long End Type ' for SHGetPathFromIDList, pszString must be at least MAX_PATH (260) chars Private Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpbi As BROWSEINFO) As Long Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal ptr As Long) ' BrowseForFolder() returns a path if the user picks a good one, or "" if they don't. Public Function BrowseForFolder(ByVal hWndOwner As Long, Optional ByVal dlgTitle$ = "Please select a folder.", Optional ByVal flags As browseInfoFlags = BIF_RETURNONLYFSDIRS) As String Dim bif As BROWSEINFO, pidl As Long, buf$ With bif .hWndOwner = hWndOwner .pidlRoot = 0 ' desktawp .pszDisplayName = Space$(MAX_PATH) .lpszTitle = dlgTitle$ .ulFlags = flags .lpfn = 0& .lParam = 0& .iImage = 0& End With pidl = SHBrowseForFolder(bif) If (pidl = 0) Then Exit Function buf$ = Space$(MAX_PATH) If (SHGetPathFromIDList(pidl, buf$) = 0) Then buf$ = "" Else buf$ = Left$(buf$, InStr(1, buf$, vbNullChar) - 1) End If CoTaskMemFree pidl BrowseForFolder = buf$ End Function
In a form:
VB Code:
Private Sub Command1_Click() Dim strResFolder As String strResFolder = BrowseForFolder(hWnd, "Please select a folder.") If strResFolder = "" Then Call MsgBox("The Cancel button was pressed.", vbExclamation) Else Call MsgBox("The folder " & strResFolder & " was selected.", vbExclamation) End If End Sub
Change the InitDir property
:)
VB Code:
Option Explicit Private Type BROWSEINFO hwndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) Private Declare Function lStrCat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long Private Const BIF_RETURNONLYFSDIRS = 1 Public Function BrowseForFolder(ByVal lHwnd As Long, ByVal sPrompt As String) As String Dim tBI As BROWSEINFO Dim lList As Long Dim lResult As Long Dim sPath As String Dim sString As String sString = Space(260) With tBI .hwndOwner = lHwnd .lpszTitle = lStrCat(sPrompt, Chr(0)) .pszDisplayName = StrPtr(sString) .ulFlags = BIF_RETURNONLYFSDIRS End With lList = SHBrowseForFolder(tBI) sString = StrConv(sString, vbUnicode) If lList Then sPath = Space(260) lResult = SHGetPathFromIDList(lList, sPath) Call CoTaskMemFree(lList) sPath = Left$(sPath, InStr(sPath, Chr(0)) - 1) End If BrowseForFolder = sPath End Function Private Sub Command1_Click() Msgbox BrowseForFolder(hWnd, "Select Directory..") End Sub
Maybe I should retire now..I'm getting to old and slow for this :rolleyes:.
Thanks for the code!
And now I want to set default folder for the dialog.
What i have to do?