VB6 'browse for folder' button

Posted on 2011-03-02
Last Modified: 2012-05-11
I want to add a 'browse for folder' button that will open a dialog allowing the user to browse + choose a folder, and return its filepath.
There are many such scripts available, and I have tried several, but not found one that includes both of these features in one:
- includes a 'Create New folder' button for the user.
- the function should have an input parameter allowing me to set or highlight the starting or 'initial' folder for the user.  (This is not the same as a Root folder, and should not block user from navigating up or out).  
About the closest I came is a script from here:
I zipped and attached my version here.  
It allows EITHER of the above mentioned features, but not both at same time!
BUT Problems:
When choosing the 'CreateNewFolder' option it shows a nice, large dialog that is positioned way off at bottom right (on my computer), not fully showing.   Needs to be dragged to be used.
And, it does not allow me to set an initial starting folder.
The other option allows me to set an initial starting folder, but then no more 'new folder' button! Also it produces a smaller, not so easy to navigate dialog, although this one is at least centered correctly.  
I did find one script that SAYS it does everything:
But, it is very long complex code, containing many modules.   I, a newbie, could understand nothing, nor get it to run.  The page claims only 2 of the modules are needed, and could be added to my app.   But I was completely lost in trying that.
Question by:galaxy7

Assisted Solution

rawinnlnx9 earned 200 total points
ID: 35024235
Shamelessly taken from:

Option Explicit

Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) 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 Const BIF_RETURNONLYFSDIRS  As Long = 1
Private Const CSIDL_DRIVES          As Long = &H11
Private Const WM_USER               As Long = &H400
Private Const MAX_PATH              As Long = 260 ' Is it a bad thing that I memorized this value?

'// message from browser
Private Const BFFM_INITIALIZED     As Long = 1
Private Const BFFM_SELCHANGED      As Long = 2
Private Const BFFM_VALIDATEFAILEDA As Long = 3 '// lParam:szPath ret:1(cont),0(EndDialog)
Private Const BFFM_VALIDATEFAILEDW As Long = 4 '// lParam:wzPath ret:1(cont),0(EndDialog)
Private Const BFFM_IUNKNOWN        As Long = 5 '// provides IUnknown to client. lParam: IUnknown*

'// messages to browser
Private Const BFFM_SETSTATUSTEXTA   As Long = WM_USER + 100
Private Const BFFM_ENABLEOK         As Long = WM_USER + 101
Private Const BFFM_SETSELECTIONA    As Long = WM_USER + 102
Private Const BFFM_SETSELECTIONW    As Long = WM_USER + 103
Private Const BFFM_SETSTATUSTEXTW   As Long = WM_USER + 104
Private Const BFFM_SETOKTEXT        As Long = WM_USER + 105 '// Unicode only
Private Const BFFM_SETEXPANDED      As Long = WM_USER + 106 '// Unicode only

Private Type BrowseInfo
  hWndOwner         As Long
  pIDLRoot          As Long
  pszDisplayName    As Long
  lpszTitle         As String
  ulFlags           As Long
  lpfnCallback      As Long
  lParam            As Long
  iImage            As Long
End Type

Private Function PtrToFunction(ByVal lFcnPtr As Long) As Long
  PtrToFunction = lFcnPtr
End Function

Private Function CorrectPath(ByVal sPath As String) As String
  If Right$(sPath, 1) = "\" Then
    If Len(sPath) > 3 Then sPath = Left$(sPath, Len(sPath) - 1) ' Strip backslash from non-root
    If Len(sPath) = 2 Then sPath = sPath & "\"                  ' Append backslash to root
  End If
  CorrectPath = sPath
End Function

Private Function DirectoryExists(ByVal sDirectory As String) As Long
  If LenB(sDirectory) Then
    If GetFileAttributes(sDirectory) >= vbNormal Then
      DirectoryExists = True
    End If
  End If
End Function

Public Function FolderBrowser(ByVal sDialogTitle As String, ByVal sPath As String) As String
  Dim b(MAX_PATH) As Byte
  Dim pItem       As Long
  Dim sFullPath   As String
  Dim bi          As BrowseInfo
  Dim ppidl       As Long
  sPath = CorrectPath(sPath)
  bi.hwndOwner = Screen.ActiveForm.hwnd
  SHGetSpecialFolderLocation bi.hwndOwner, CSIDL_DRIVES, ppidl
  bi.pIDLRoot = ppidl
  bi.pszDisplayName = VarPtr(b(0))
  bi.lpszTitle = sDialogTitle
  If DirectoryExists(sPath) Then bi.lpfnCallback = PtrToFunction(AddressOf BFFCallback)
  bi.lParam = StrPtr(sPath)

  pItem = SHBrowseForFolder(bi)
  If pItem Then ' Succeeded
    sFullPath = Space$(MAX_PATH)
    If SHGetPathFromIDList(pItem, sFullPath) Then
      FolderBrowser = Left$(sFullPath, InStr(sFullPath, vbNullChar) - 1) ' Strip nulls
      CoTaskMemFree pItem
    End If
  End If
End Function

' typedef int (CALLBACK* BFFCALLBACK)(HWND hwnd, UINT uMsg, LPARAM lParam, LPARAM lpData);
Public Function BFFCallback(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal sData As String) As Long
    SendMessage hwnd, BFFM_SETSELECTIONA, True, ByVal sData
  End If
End Function

Open in new window


' Usage (in VB anyway)
Private Sub Form_Load()
  Show  ' So ActiveForm.Hwnd is initialized
  Debug.Print FolderBrowser("Select a directory:", App.Path)
End Sub

Open in new window


Expert Comment

ID: 35024268
If you have ongoing VB6 needs I highly recommend Matthew Curland's Advanced VB6, Power Techniques for Everyday Programmers.

Author Comment

ID: 35024523
OK, thanks.  there r 3 versions on that site, so I will try all 3, and report back here.  
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

LVL 76

Accepted Solution

GrahamSkan earned 300 total points
ID: 35024615
If you want something simple, you can create your own using the intrinsic Dirve and Dir boxes. Here is an example.

Author Comment

ID: 35024676
Well, we are getting there!   The actual code you pointed me to I didn't understand.   It's a module?  I used it as a module, then tried from my main form:
Private Sub Command1_Click()
Debug.Print FolderBrowser("Select a directory:", "G:\! !TEMP")
End Sub
But got a msg: "compile error.  Expected varialbe or proceedure, not module"
But I tried RayOK's code on that same xtremevbtalk thread, which explained how to use it, and it (sorta) worked.   I was able to initiate a starting folder, and also have a 'create folder' button.  
BUT…. The same problem of this Browse Dialog showing off the screen happens.   It shows in the bottom-right of screen, only partially visible.  The user would need to understand what it is, and then drag it into view.  Obviously not acceptable.  It might possibly be something on my computer that does this…??  But I have some similar code in C++, and it works fine, centered and all….
So… how to center the dialog with VB6…?

Author Comment

ID: 35025097
@GrahamSkan:  I tried your code for creating my own folder browser.  It is a nice idea!  I still prefer the usual tree-directory, but perhaps I could find a tree-directory control somewhere and use that?  
It is 4am, and I need to sleep, but I will play around with suggestions tommorrow and onward.
I'd still like to know why the usual 'MS Browse Dialog' is way off to the corner on my system, in VB code, but not C++.  I'll try on another computer tommorrow.

Expert Comment

ID: 35028142

Please set the hwndOwner member on BROWSER_INFO structure to the form that initializes the dialog.
bi.hwndOwner = Form1.hWnd

Open in new window


Author Closing Comment

ID: 35041428
2 solutions.  Both work, in different ways.  
  (PS: The additional problem about dialog not centering does not happen on other computers, and was due to my stretching the size of the dialog)

Author Comment

ID: 35041436
 (PS:@ MedievalWarrior I also tried your idea at the end, but it didn't seem to have an effect. Thanks anyway; a good idea.)

Author Comment

ID: 35041441
PS: I awarded points to both solutions.

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
groupSumClump challenge 9 125
vb6 connector to SQL Server 2 37
Problem to open text file 11 128
VB6 ListBox Question 4 48
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
The viewer will learn how to user default arguments when defining functions. This method of defining functions will be contrasted with the non-default-argument of defining functions.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

860 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question