Как в CommonDialog открыть папку?

Private Sub Command3_Click()
 
Dim prob As String: otbras As Integer: nach_schet As Integer
Dim prob1 As String: probila As String
Dim prob2 As String
Dim chisla As Integer: Dim vseti As String
prob = ':'
probila = ' ': vseti = '\ '
nach_schet = 0: chisla = 1
 
On Error GoTo ErrorHandler
CommonDialog1.ShowOpen
If ShowOpen = 0 Then prob1 = CommonDialog1.FileName
 
Do Until prob = Left(prob2, 1) ' Ищет значёк :
If probila = Left(prob2, 1) Then nach_schet = 1 ' Ищет значёк   (длину файла)
If vseti = Left(prob2, 2) Then otbras = otbras - 1: Exit Do 'Исли открываем по сети то опрашиваем \
otbras = otbras + nach_schet
prob2 = Right(prob1, chisla)
chisla = chisla + 1
Loop
 
Text1 = Left(prob1, otbras + 1) 'Отбрасывает в пути ******** те. имя файла
Exit Sub
ErrorHandler:
End Sub

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
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260
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 Sub Form_Load()
    Dim iNull As Integer, lpIDList As Long, lResult As Long
    Dim sPath As String, udtBI As BrowseInfo
    With udtBI
        .hWndOwner = Me.hWnd
        .lpszTitle = lstrcat("C: ", "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    'Show the 'Browse for folder' dialog
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        SHGetPathFromIDList lpIDList, sPath
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If
 
    MsgBox sPath
End Sub

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 
 
Public Enum BrowseType 
BrowseForFolders = &H1 
BrowseForComputers = &H1000 
BrowseForPrinters = &H2000 
BrowseForEverything = &H4000 
End Enum 
 
Public Enum FolderType 
CSIDL_BITBUCKET = 10 
CSIDL_CONTROLS = 3 
CSIDL_DESKTOP = 0 
CSIDL_DRIVES = 17 
CSIDL_FONTS = 20 
CSIDL_NETHOOD = 18 
CSIDL_NETWORK = 19 
CSIDL_PERSONAL = 5 
CSIDL_PRINTERS = 4 
CSIDL_PROGRAMS = 2 
CSIDL_RECENT = 8 
CSIDL_SENDTO = 9 
CSIDL_STARTMENU = 11 
End Enum 
 
Private Const MAX_PATH = 260 
 
Private Declare Sub CoTaskMemFree Lib 'ole32.dll' (ByVal hMem As Long) 
Private Declare Function lstrcat Lib 'kernel32.dll' Alias 'lstrcatA' (ByVal lpString1 As String, ByVal lpString2 As String) As Long 
Private Declare Function SHBrowseForFolder Lib 'shell32.dll' (lpbi As BrowseInfo) As Long 
Private Declare Function SHGetPathFromIDList Lib 'shell32.dll' (ByVal pidList As Long, ByVal lpBuffer As String) As Long 
Private Declare Function SHGetSpecialFolderLocation Lib 'shell32.dll' (ByVal hWndOwner As Long, ByVal nFolder As Long, ListId As Long) As Long 
 
Public Function BrowseFolders(hWndOwner As Long, sMessage As String, Browse As BrowseType, ByVal RootFolder As FolderType) As String 
Dim Nullpos As Integer 
Dim lpIDList As Long 
Dim res As Long 
Dim sPath As String 
Dim BInfo As BrowseInfo 
Dim RootID As Long 
SHGetSpecialFolderLocation hWndOwner, RootFolder, RootID 
BInfo.hWndOwner = hWndOwner 
BInfo.lpszTitle = lstrcat(sMessage, '') 
BInfo.ulFlags = Browse 
If RootID <> 0 Then BInfo.pIDLRoot = RootID 
lpIDList = SHBrowseForFolder(BInfo) 
If lpIDList <> 0 Then 
sPath = String(MAX_PATH, 0) 
res = SHGetPathFromIDList(lpIDList, sPath) 
Call CoTaskMemFree(lpIDList) 
Nullpos = InStr(sPath, vbNullChar) 
If Nullpos <> 0 Then 
sPath = Left(sPath, Nullpos - 1) 
End If 
End If 
BrowseFolders = sPath 
End Function 
 
Private Sub Command1_Click() 
'следующие вызовы функции сработали нормально 
MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_DESKTOP) '+весь компьютер 
'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_DRIVES) '+только устройства 
'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_NETHOOD) '+только сеть 
'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_PROGRAMS) '+папка Программы 
'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_STARTMENU) '+Главное меню 
 
'результат действия следующих кодов вызвал недоумение... 
'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_BITBUCKET) '-корзина 
'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_CONTROLS) '-панель управления 
'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_FONTS) '-папка со шрифтами 
'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_NETWORK) '-NetHood