SHBrowseForFolder API - Network Folders only

[FrogBoy666]

Ok... I'm trying to use the BrowseForFolder API, and I hit a snag. Currently, it displays all directories and folders, but I would like it limit its display to the network folders. Here's the code I'm using:

Option Explicit

Public 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 Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_EDITBOX = &H10
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_USENEWUI = &H40
Public Const BIF_VALIDATE = &H20

Public Const MAX_PATH = 260

Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
     
    'declare variables to be used
     Dim iNull As Integer
     Dim lpIDList As Long
     Dim lResult As Long
     Dim sPath As String
     Dim udtBI As BrowseInfo

    'initialise variables
     With udtBI
        .hwndOwner = hwndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
     End With

    'Call the browse for folder API
     lpIDList = SHBrowseForFolder(udtBI)
     
    'get the resulting string path
     If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then sPath = Left$(sPath, iNull - 1)
     End If

    'If cancel was pressed, sPath = ""
     BrowseForFolder = sPath

End Function

[JordanChris]

You can't limit the drives shown when using SHBrowseForFolder. You can start the search at a particular place, if that is good enough for you....


Rather than starting the search for a folder from the top level (the desktop), it is often desirable to search for a folder starting from a known point (like the last folder that was selected).

With the SHBrowseForFolder API function used above, it involves using a Call Back Procedure – as shown below. This procedure sends a message to the browsing window, telling it to start the display where the parameter specifies.

In order to implement this, certain API and function definitions are required in a code module:


Public Declare Function SHBrowseForFolder Lib "shell32.dll" _
(lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Public Type BROWSEINFO
howner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
lImage As Long
End Type
Public bi As BROWSEINFO
Public pidl As Long

'release the memory used by the browse for folder
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Public Const LMEM_FIXED = &H0
Public Const LMEM_ZEROINIT = &H40
Public Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)

'send a message to the browse for folder window
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SELECTIONCHANGED = 2

'allocate and free space for the folder parameter
‘ that is to be passed to browse for folder
Public Declare Function LocalAlloc Lib "kernel32" _
(ByVal uFlags As Long, _
ByVal uBytes As Long) As Long
Public Declare Function LocalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)

Public Const MAX_PATH = 260
Public Const WM_USER = &H400
Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Public Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)



Public Function BrowseCallbackProcStr(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Called from the browse for folder window
'Sets the initial path to whatever has already been set
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTIONA, _
True, ByVal lpData)
Case Else:
End Select
End Function

Public Function FARPROC(ByVal pfn As Long) As Long
'A dummy procedure that receives and
' returns the return value of the AddressOf operator.
'Used to get a pointer (AddressOf) to the call back routine.
FARPROC = pfn
End Function




As well as the definitions above, the actual code to do the calling of the Browse For Folder window is required. This code sets the initial folder required, although it is the call back routine that actually makes the window select the specified directory.



Dim lpSelPath As Long
Dim sPath As String * MAX_PATH
Dim pidl as long

' Get the folder required.
' Allocate it in some memory, with a pointer to it
sPath = “C:\Program Files”
lpSelPath = LocalAlloc(LPTR, Len(sPath) + 1)
CopyMemory ByVal lpSelPath, ByVal sPath, Len(sPath) + 1

With bi
If IsNumeric(hWnd) Then .howner = hWnd
.pidlRoot = 0
.lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
.lParam = lpSelPath
.lpszTitle = "Select a Registered File folder:" & Chr$(0)
End With

pidl = SHBrowseForFolder(bi)
If pidl Then
If SHGetPathFromIDList(ByVal pidl, ByVal gMyFolder) Then
gMyFolder = Left(Trim(gMyFolder), _
Len(Trim(gMyFolder)) - 1)
End If
Call CoTaskMemFree(pidl)
End If
Call LocalFree(lpSelPath)

' gMyFolder now holds the path and folder actually selected

[FrogBoy666]

Thanks for the help...

That appears to do the same thing as my code. Mine successfully allows me to browse for folders, but I only wanted to browse the Network Neighborhood and below. Such as in Windows 2000*, when you are in Windows Explorer and go to Tools>Map Network Drive, and click the Browse... button. When the Browse For Folder dialog appears, the top of the tree is Network Neighborhood. That's what I want.

Thanks again!

* This could possibly occur in WinNT4 or 9x... I only have access to 2000 right now.

[FrogBoy666]

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:

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:

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