How to browse folder using Windows API

Download Source 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 Declare Function getTempPathAPI Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
Private Const MAX_PATH = 1024

Private Sub Command1_Click()
  Dim b As BrowseInfo
  MsgBox BrowseForFolder(0, "Browse", "c:\")
End Sub

Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String, ByVal StartLocation As String) As String
    'Declare variables to be used
     Dim iNull As Integer
     Dim lpIDList As Long
     Dim lResult As Long
     Dim sPath As String
     Dim BI As BrowseInfo
    'Initialise Type variables
     With BI
        .hwndOwner = hwndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
        .lpfnCallback = getFunctionLong
        .lParam = lstrcat(StartLocation, "")
     End With
    'Call the browse for folder API
     lpIDList = SHBrowseForFolder(BI)
    'Get the resulting string path
     If lpIDList Then
        sPath = String$(MAX_PATH, Chr$(0))
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then sPath = Left$(sPath, iNull - 1)
     End If
    'If cancelled, set sPath = ""
     BrowseForFolder = sPath
End Function