Option Explicit
 
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
 
Private Declare Function SHBrowseForFolder Lib "shell32" (lpBI As BrowseInfo) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
 
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 Function BrowseFolder()
 
    Dim lpIDList As Long
    Dim sbuffer As String
    Dim szTitle As String
    Dim tBrowseInfo As BrowseInfo
    szTitle = "Choose PrLr Scheduler Sound Folder"
 
 
    With tBrowseInfo
        .hwndOwner = Me.hWnd
        .lpszTitle = lstrcat(szTitle, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
 
    End With
    lpIDList = SHBrowseForFolder(tBrowseInfo)
 
 
    If (lpIDList) Then
        sbuffer = Space(MAX_PATH)
        SHGetPathFromIDList lpIDList, sbuffer
        sbuffer = Left(sbuffer, InStr(sbuffer, vbNullChar) - 1)
 
        BrowseFolder = sbuffer
 
    End If
 
End Function
 
Private Sub Command1_Click()
    Call BrowseFolder
End Sub