Select a Folder in Visual Basic

[ruizata]

To select a file I use CommonDialog.

But what i use for select a folder?

[Hack]

'in a module
Option Explicit
 
Public 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
 
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BFFM_INITIALIZED = 1
Public Const MAX_PATH = 260
 
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function MoveWindow Lib "User32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
 
Public Function BrowseForFolder(hWndOwner As Long, sPrompt As String) As String
    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, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
        .lpfnCallback = PassBackAddress(AddressOf BrowseCallBackProc)
    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
    End If
 
    BrowseForFolder = sPath
 
End Function
 
Public Function BrowseCallBackProc(ByVal BrowseHWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lpData As Long) As Long
    Dim lReturn As Long
    If uMsg = BFFM_INITIALIZED Then
        lReturn = MoveWindow(BrowseHWnd, 50, 50, 425, 400, 1)
    End If
    BrowseCallBackProc = 0
End Function
 
Public Function PassBackAddress(ByVal lPointer As Long) As Long
    PassBackAddress = lPointer
End Function
 
'on a form
Private Sub Command1_Click()
Dim sMyFolder As String
sMyFolder = BrowseForFolder(Form1.hWnd, "Select A Folder And Click OK")
Text1.Text = sMyFolder
End Sub