I've never been successful setting the root to anything other than a drive's
root. The follow streamlined code (no callback) sets the browse root to C:
but trying to set it lower results in a browse dialog that doesn't open.

Another problem with this solution, even if it did work, is that it uses an
undocumented Windows API call. No telling how reliable it is or if it will
be supported in the future.

--
Jim Rech
Excel MVP

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'Main Browse for directory function
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'Gets path from pidl
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String)
As Long
''UNDOCUMENTED!!!!
Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" (ByVal
szPath As String) As Long

Sub Demo()
Dim RetStr As String
RetStr = GetDirectory("Choose path", "C:\") ''but C:\ABC doesn't work
If RetStr < "" Then MsgBox RetStr
End Sub

Function GetDirectory(Msg As String, TreeRoot As String) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim ItemIdentifierListAddress As Long
Dim PathUnicode As String
PathUnicode = StrConv(TreeRoot, vbUnicode)
bInfo.pidlRoot = SHSimpleIDListFromPath(PathUnicode)
If Not IsMissing(Msg) Then bInfo.lpszTitle = Msg
ItemIdentifierListAddress = SHBrowseForFolder(bInfo)
GetDirectory = GetPathFromID(ItemIdentifierListAddress)
End Function

'Converts a PIDL to a string
Function GetPathFromID(ID As Long) As String
Dim Result As Boolean, Path As String * 255
Result = SHGetPathFromIDList(ID, Path)
If Result Then
GetPathFromID = Left(Path, InStr(Path, Chr$(0)) - 1)
Else
GetPathFromID = ""
End If
End Function