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 Const BIF_BROWSEFORCOMPUTER = &H1000 Private Const BIF_BROWSEFORPRINTER = &H2000 Private Const BIF_BROWSEINCLUDEFILES = &H4000 Private Const BIF_DONTGOBELOWDOMAIN = &H2 Private Const BIF_RETURNFSANCESTORS = &H8 Private Const BIF_RETURNONLYFSDIRS = &H1 Private Const BIF_STATUSTEXT = &H4 Private Const MAX_PATH = 260 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 Public Function fBrowseForFolder(hWndOwner As Long, sPrompt As String) As String ' ' Opens the system dialog for browsing for a folder. ' Dim iNull As Integer Dim lpIDList As Long Dim lResult As Long Dim sPath As String Dim udtBI As BrowseInfo With udtBI .hWndOwner = hWndOwner .lpszTitle = lstrcat(sPrompt, "") If Option1(0).Value Then ' Solo directory e Driver .ulFlags = BIF_RETURNONLYFSDIRS ElseIf Option1(1).Value Then ' Solo directory e Driver e Files .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_BROWSEINCLUDEFILES ElseIf Option1(2).Value Then ' computer .ulFlags = BIF_BROWSEFORCOMPUTER Else ' stampanti .ulFlags = BIF_BROWSEFORPRINTER End If End With lpIDList = SHBrowseForFolder(udtBI) If lpIDList Then sPath = String$(MAX_PATH, 0) lResult = SHGetPathFromIDList(lpIDList, sPath) Call CoTaskMemFree(lpIDList) iNull = InStr(sPath, vbNullChar) If iNull Then sPath = Left$(sPath, iNull - 1) End If fBrowseForFolder = sPath End Function Private Sub cmdBrowse_Click() Dim sStr As String sStr = fBrowseForFolder(hWnd, "Click on an entry to select it.") If sStr <> "" Then MsgBox sStr, vbInformation, "Directory Browser" End If End Sub Private Sub cmdQuit_Click() Unload Me End Sub Private Sub Form_Load() Option1(0).Value = True End Sub |