GetFolder

Sub Main()
Dim Folder As String
Folder = GetFolder
If Not Folder = "" Then
  MsgBox Folder
Else
  MsgBox "Couldn't find folder."
End If
End Sub
Function GetFolder(Optional Title As String, Optional hWnd) As String
Dim bi As BROWSEINFO
Dim pidl As Long
Dim Folder As String
Folder = String$(255, Chr$(0))
With bi
  If IsNumeric(hWnd) Then .hOwner = hWnd
  .ulFlags = BIF_RETURNONLYFSDIRS
  .pidlRoot = 0
  If Not IsMissing(Title) Then
    .lpszTitle = Title
  Else
    .lpszTitle = "Select a Folder" & Chr$(0)
  End If
End With
pidl = SHBrowseForFolder(bi)
If SHGetPathFromIDList(ByVal pidl, ByVal Folder) Then
  GetFolder = Left(Folder, InStr(Folder, Chr$(0)) - 1)
Else
  GetFolder = ""
End If
End Function