You actually CAN limit the drives shown when using SHBrowseForFolder...
As you can see from the dates, it has been a while since I originally posted this...
It turns out that you can, in fact limit the drives shown when using SHBrowseForFolder. You accomplish this by using the CSIDL constants in conjunction with the SHGetSpecialFolderLocation API call.
Here's how...
Use the following code to run everything:
Code:
Private Sub Form_Load()
With BrowseFolders(Me)
If .Path = "" Then
.Path = "(Virtual Folder)"
End If
MsgBox "Selected Folder: " & .Folder & Chr(13) & _
"Physical Path: " & .Path
End With
End Sub
Drop this code into a module:
Code:
Public Type SELECTEDPATH
Path As String
Folder As String
End Type
Public Type BROWSEINFO
hwndOwner 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
Private Const BFFM_ENABLEOK = &H465
Private Const BFFM_SETSELECTION = &H466
Private Const BFFM_SETSTATUSTEXT = &H464
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_VALIDATEFAILED = 3
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const BIF_BROWSEINCLUDEFILES = &H4000
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_EDITBOX = &H10
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_USENEWUI = &H40
Private Const BIF_VALIDATE = &H20
Private Const CSIDL_FLAG_CREATE = &H8000
Private Const CSIDL_FLAG_DONT_VERIFY = &H4000
'Windows 2000: The Administration Tools folder:
Private Const CSIDL_ADMINTOOLS = &H30
'The non-localized Startup folder:
Private Const CSIDL_ALTSTARTUP = &H1D
'The Application Data folder (stores common program data):
Private Const CSIDL_APPDATA = &H1A
'The Recycle Bin on the desktop:
Private Const CSIDL_BITBUCKET = &HA
'Windows 2000: The Administration Tools folder common to all users:
Private Const CSIDL_COMMON_ADMINTOOLS = &H2F
'Windos NT, 2000: The non-localized Startup folder common to all users:
Private Const CSIDL_COMMON_ALTSTARTUP = &H1D
'Windows 2000: The Application Data folder (stores common program data) common to all users:
Private Const CSIDL_COMMON_APPDATA = &H23
'Windows NT, 2000: The Desktop directory (stores file objects on desktop) common to all users:
Private Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19
'Windows NT, 2000: The Documents folder common to all users:
Private Const CSIDL_COMMON_DOCUMENTS = &H2E
'Windows NT, 2000: The Favorites folder common to all users:
Private Const CSIDL_COMMON_FAVORITES = &H1F
'Windows NT, 2000: The Programs folder under the Start Menu common to all users:
Private Const CSIDL_COMMON_PROGRAMS = &H17
'Windows NT, 2000: The Start Menu folder common to all users:
Private Const CSIDL_COMMON_STARTMENU = &H16
'Windows NT, 2000: The Startup folder under Start Menu\Programs common to all users:
Private Const CSIDL_COMMON_STARTUP = &H18
'Windows NT, 2000: The Templates folder common to all users:
Private Const CSIDL_COMMON_TEMPLATES = &H2D
'The Control Panel:
Private Const CSIDL_CONTROLS = &H3
'The folder used for Internet Explorer's cookie list:
Private Const CSIDL_COOKIES = &H21
'The Windows desktop:
Private Const CSIDL_DESKTOP = &H0
'The Desktop directory (holds file objects on the Windows desktop):
Private Const CSIDL_DESKTOPDIRECTORY = &H10
'The My Computer folder:
Private Const CSIDL_DRIVES = &H11
'The Favorites folder (stores Internet Explorer's bookmarks):
Private Const CSIDL_FAVORITES = &H6
'The Fonts directory (holds the fonts installed in Windows):
Private Const CSIDL_FONTS = &H14
'The folder used for Internet Explorer's history list:
Private Const CSIDL_HISTORY = &H22
'The Internet (refering to the Internet Explorer icon on the desktop):
Private Const CSIDL_INTERNET = &H1
'The folder used for Internet Explorer's cache:
Private Const CSIDL_INTERNET_CACHE = &H20
'With Internet Explorer 5.0 or later: Local Application Data folder:
Private Const CSIDL_LOCAL_APPDATA = &H1C
'With Internet Explorer 5.0 or later: The My Pictures folder:
Private Const CSIDL_MYPICTURES = &H27
'The Nethood directory (holds objects appearing in Network Neighborhood):
Private Const CSIDL_NETHOOD = &H13
'The Network Neighborhood folder:
Private Const CSIDL_NETWORK = &H12
'The My Documents folder:
Private Const CSIDL_PERSONAL = &H5
'The Printers folder (under My Computer):
Private Const CSIDL_PRINTERS = &H4
'The PrintHood directory (stores printer links):
Private Const CSIDL_PRINTHOOD = &H1B
'With Internet Explorer 5.0 or later: The user profile folder:
Private Const CSIDL_PROFILE = &H28
'With Internet Explorer 5.0 or later: The Program Files folder:
Private Const CSIDL_PROGRAM_FILES = &H26
'Windows NT, 2000: The Common folder under Program Files:
Private Const CSIDL_PROGRAM_FILES_COMMON = &H2B
'Windows 2000: The x86 Common folder under Program Files for RISC systems:
Private Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C
'Windows 2000: The x86 Program Files directory on RISC systems:
Private Const CSIDL_PROGRAM_FILESX86 = &H2A
'The Programs folder in the Start Menu:
Private Const CSIDL_PROGRAMS = &H2
'The Recent folder (used for the Documents list in the Start Menu):
Private Const CSIDL_RECENT = &H8
'The Send To folder (stores Send To menu items):
Private Const CSIDL_SENDTO = &H9
'The Start Menu:
Private Const CSIDL_STARTMENU = &HB
'The Startup folder under Start Menu\Programs:
Private Const CSIDL_STARTUP = &H7
'With Internet Explorer 5.0 or later: The Windows System directory:
Private Const CSIDL_SYSTEM = &H25
'Windows 2000: The x86 system directory on RISC systems:
Private Const CSIDL_SYSTEMX86 = &H29
'The Templates folder (stores document templates):
Private Const CSIDL_TEMPLATES = &H15
'With Internet Explorer 5.0 or later: The Windows directory:
Private Const CSIDL_WINDOWS = &H24
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, ppidl As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private gstrChosenPath As String
Public Function DummyFunc(ByVal param As Long) As Long
DummyFunc = param
End Function
Public Function BrowseCallbackProc(ByVal hWnd As Long, _
ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Dim pathstring As String 'name of path to set by default
Dim retval As Long 'return value
Select Case uMsg
Case BFFM_INITIALIZED
pathstring = gstrChosenPath
retval = SendMessage(hWnd, BFFM_SETSELECTION, ByVal CLng(1), _
ByVal pathstring)
End Select
BrowseCallbackProc = 0 'the function should always return 0
End Function
Public Function BrowseFolders _
(ParentForm As Form, Optional DefaultDir As String) As SELECTEDPATH
Dim bi As BROWSEINFO 'structure passed to the function
Dim pidl As Long 'PIDL to the user's selection
Dim physpath As String 'string used to temporarily hold the physical path
Dim retval As Long 'return value
If DefaultDir = "" Then
gstrChosenPath = Left(App.Path, 3)
Else
gstrChosenPath = DefaultDir
End If
'Initialize the structure to be passed to the function.
bi.hwndOwner = ParentForm.hWnd
'Specify the My Computer virtual folder as the root
retval = SHGetSpecialFolderLocation(ParentForm.hWnd, CSIDL_NETWORK, bi.pidlRoot)
bi.pszDisplayName = Space(260) 'Make room for virtual folder's name.
bi.lpszTitle = "Please choose a folder:"
bi.ulFlags = 0
bi.lpfn = DummyFunc(AddressOf BrowseCallbackProc)
bi.lParam = 0
bi.iImage = 0
pidl = SHBrowseForFolder(bi) 'Open the Browse for Folder dialog box.
'Display selected name and physical location:
If pidl <> 0 Then
'Remove empty space:
bi.pszDisplayName = _
Left(bi.pszDisplayName, InStr(bi.pszDisplayName, vbNullChar) - 1)
BrowseFolders.Folder = bi.pszDisplayName
'Display its physical location of non-virtual folders:
physpath = Space(260)
retval = SHGetPathFromIDList(pidl, physpath)
If retval = 0 Then
BrowseFolders.Path = ""
Else
'Remove the empty space and display the result:
BrowseFolders.Path = Left(physpath, InStr(physpath, vbNullChar) - 1)
End If
'Free the pidl returned by the function:
Call CoTaskMemFree(pidl)
End If
Call CoTaskMemFree(bi.pidlRoot)
End Function
