Browse for Folder 4

[VictoryHighway]

Greetings,
I have read faq222-867 to use the Windows built-in browse for folder function in my project. What I would like to know is if this can be modified so that the starting folder that I specify can be used as the "root" of the browse window? Thanks in advance.

--Geoffrey

 

[bjd4jc]

You will want to look at this page:

http://www.vbaccelerator.com/home/V...ch_Demonstration_zip_cBrowseForFolder_cls.asp

You will also need to download the Type Library and add it as a reference from

http://www.vbaccelerator.com/home/VB/Type_Libraries/IShellFolder/IShellFolder_Type_Library.asp

You will want to observe the pIDLRoot variable in the BROWSEINFO Type and pay attention to the PathToPidl function

 

[VictoryHighway]

OK, I've downloaded the class module and the type library and put references to both in my project.

Now, unfortunately, I am lost. How do I call this in my own code?

--Geoffrey

 

[bjd4jc]

Here is some started code that I adapted from the above websites.

Option Explicit
'--------------------------------------------------------------
'--------------Start "browse for folder" declarations------------
Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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 Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
Private Declare Function SHGetDesktopFolder Lib "shell32.dll" (ppshf As IShellFolder) As Long

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

Private m_CurrentDirectory As String   'The current directory
'-----End "Browse for folder" declarations----



'-------------Handle "browser for folder dialog----------
Public Function BrowseForFolder(owner As Form, Title As String, StartDir As String) As String
  'Opens a Treeview control that displays the directories in a computer

  Dim lpIDList As Long
  Dim szTitle As String
  Dim sBuffer As String
  Dim tBrowseInfo As BrowseInfo
  m_CurrentDirectory = StartDir & vbNullChar

  szTitle = Title
  With tBrowseInfo
    [b].pIDLRoot = PathToPidl("H:\")[/b] 'Put this before you set the title
    .hWndOwner = owner.hwnd
    .lpszTitle = lstrcat(szTitle, "")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
    .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)  'get address of function.
  End With

  lpIDList = SHBrowseForFolder(tBrowseInfo)
  If (lpIDList) Then
    sBuffer = Space(MAX_PATH)
    SHGetPathFromIDList lpIDList, sBuffer
    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    BrowseForFolder = sBuffer
  Else
    BrowseForFolder = ""
  End If
  
End Function


Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
  
  Dim lpIDList As Long
  Dim ret As Long
  Dim sBuffer As String
  
  On Error Resume Next  'Sugested by MS to prevent an error from
                        'propagating back into the calling process.
     
  Select Case uMsg
  
    Case BFFM_INITIALIZED
      Call SendMessage(hwnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
      
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
      
      ret = SHGetPathFromIDList(lp, sBuffer)
      If ret = 1 Then
        Call SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
      
  End Select
  
  BrowseCallbackProc = 0
  
End Function

' This function allows you to assign a function pointer to a vaiable.
Private Function GetAddressofFunction(add As Long) As Long
  GetAddressofFunction = add
End Function
'-------------End handle "browser for folder" dialog----------

[b]
Private Function PathToPidl(sPath As String) As Long
Dim folder As IShellFolder
Dim pidlMain As Long
Dim cParsed As Long
Dim afItem As Long
Dim lFilePos As Long
Dim lR As Long
Dim sRet As String

   ' Make sure the file name is fully qualified
   sRet = String$(MAX_PATH, 0)
   lR = GetFullPathName(sPath, MAX_PATH, sRet, lFilePos)
   If lR = 0 Then
      MsgBox "Error Occurred"
   Else
      ' debug.Assert c <= cMaxPath
      sPath = Left$(sRet, lR)

      ' Convert the path name into a pointer to an item ID list (pidl)
      Set folder = GetDesktopFolder
      ' Will raise an error if path cannpt be found:
      If 0 >= (folder.ParseDisplayName(0&, 0&, StrConv(sPath, vbUnicode), cParsed, pidlMain, afItem)) Then
         PathToPidl = pidlMain
      End If
   End If

End Function

Private Function GetDesktopFolder() As IShellFolder
    Dim lR As Long
    lR = SHGetDesktopFolder(GetDesktopFolder)
End Function
[/b]

 

[VictoryHighway]

OK, I've downloaded the class module and the type library and put references to both in my project.

Now, unfortunately, I am lost. How do I call this in my own code?

--Geoffrey

 

[bjd4jc]

Did you try the code that I posted.

 

[VictoryHighway]

I apologize for the duplicate post. My browser said that the document contained no data.

To answer your question, I did try your code. However, I'm getting a "Sub or Function Not Defined" when VB tries to run the following line in the PathToPidl function:

lR = GetFullPathName(sPath, MAX_PATH, sRet, lFilePos).

Is there something that I'm missing? I have already added the reference to the IShellFolder type library to my project.

--Geoffrey

 

[bjd4jc]

Yeah, I assume that you put my code in with the class module. I didn't mean for you to do that.

I extracted what is needed out of the class module (I actually mixed and matched the solution from the faq and from vbaccelerator) and put it into a standard module.

So, I have a form with

Private Sub Form_Load()
    BrowseForFolder Me, "This is a test", "C:\Temp"
End Sub

Sorry I wasn't more specific.

 

[VictoryHighway]

BJD4JC,
I think we're not communicating properly here. I have the BrowseForFolder under a menu_click event. That's not the issue.

When the BrowseForFolder function is called, it tries to run the following line (which calls PathToPidl)
.pIDLRoot = PathToPidl(RootDir)

After that,
The line:
lR = GetFullPathName(sPath, MAX_PATH, sRet, lFilePos)
Causes that error for Sub or Function not defined.

--Geoffrey

 

[bjd4jc]

I would recommend the following:

1. Create a new project.
2. Add a New Module
3. Add the code for the browse for folder object into the module
4. Add the code for form_load into the form
5. Run the project.
6. See if that's what you want
7. Step through the project to understand how it works.
8. Port the code from the "New" project into your project (into your menu_click event).

Like I said, the code I provided is a hybrid version of the two sources - the faq and the vbaccelerator code. There are declares that are missing from the faq.

Alternatively, you may just be missing the declare for GetFullPathName. You can add it (taken from above):

Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long

I would highly suggest that you take the time to understand what the code is doing rather than just copy and paste to make it work. See the following URLS for more information.

http://msdn.microsoft.com/library/d...ell/reference/functions/shbrowseforfolder.asp

http://msdn.microsoft.com/library/d...orm/shell/reference/structures/browseinfo.asp

http://msdn.microsoft.com/library/d...shell/programmersguide/shell_adv/pidl_ovw.asp

 

[strongm]

Here's the shorter version I normally post. You'll need a form with a command button, and to add a reference to the Microsoft Shell Controls and Automation library:

[blue]Option Explicit

'BROWSEINFO Flag values:
Private Enum BIFS
    BIF_RETURNONLYFSDIRS = &H1      'Only returns file system directories
    BIF_DONTGOBELOWDOMAIN = &H2     'Does not include network folders below domain level
    BIF_STATUSTEXT = &H4            'Includes status area in the dialog for use with callback
    BIF_RETURNFSANCESTORS = &H8     'Only returns file system ancestors.
    BIF_EDITBOX = &H10              'allows user to rename selection
    BIF_VALIDATE = &H20             'insist on valid editbox result (or CANCEL)
    BIF_USENEWUI = &H40             'Version 5.0 or later of Shell32.dll. Use the new user-interface. Setting
                                    'this flag provides the user with a larger dialog box
                                    'that can be resized. It has several new capabilities
                                    'including: drag and drop capability within the
                                    'dialog box, reordering, context menus, new folders,
                                    'delete, and other context menu commands. To use
                                    'this flag, you must call OleInitialize or
                                    'CoInitialize before calling SHBrowseForFolder.
    BIF_BROWSEFORCOMPUTER = &H1000  'Only returns computers.
    BIF_BROWSEFORPRINTER = &H2000   'Only returns printers.
    BIF_BROWSEINCLUDEFILES = &H4000 'Browse for everything
End Enum


' SHDOC32 has a reliance on Shell32.dll - this generally needs to be at least version 4.71
' or later for most of the Shell32 tricks to work
Private Function vbBrowseForFolder(Optional strRoot As Variant, Optional BIF_Flags As BIFS = 0) As String
    Dim myFolder As Shell32.Folder

    With New Shell32.Shell
        Set myFolder = .BrowseForFolder(Form1.hWnd, "Select a folder from the tree", BIF_Flags, strRoot)
        If Not myFolder Is Nothing Then vbBrowseForFolder = myFolder.ParentFolder.ParseName(myFolder.Title).Path
   End With
End Function

Private Sub Command1_Click()
    Debug.Print vbBrowseForFolder(ssfHISTORY) ' check Shell32 in VB's object browser for all possible ssf (special files) values
    Debug.Print vbBrowseForFolder("c:\windows")
End Sub
[/blue]

 

[VictoryHighway]

Thanks guys, I think I finally have it working!

--Geoffrey

 

[danewalther]

strongm,

I have updated the code from your post on 31Mar05...

In your function vbBrowseForFolder(), you define a Shell32.Folder object, and then you must use the .Parentfolder.Parsename() mechanism to get the path for the selected object.

This poses problems when you try to select, say, a root folder, that has no parent.

Instead, if you define a Shell32.Folder2 object, it has a reference to "Self" (type FolderItem), which then has the .Path property. It simplifies the code, and provides more flexibility for user selection.

Here's the updated function:

Public Function vbBrowseForFolder(frmForm As Form, Optional strRoot As Variant = "My Computer", Optional BIF_Flags As BIFS = BIF_RETURNONLYFSDIRS) As String

Dim myFolder2 As Shell32.Folder2

With New Shell32.Shell
Set myFolder2 = .BrowseForFolder(0, "Select a folder", BIF_Flags, strRoot)
If Not myFolder2 Is Nothing Then
vbBrowseForFolder = myFolder2.Self.Path
Else
vbBrowseForFolder = ""
End If
End With

End Function