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.  
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

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: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say 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

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
The viewer will learn how to use the return statement in functions in C++. The video will also teach the user how to pass data to a function and have the function return data back for further processing.
In a recent question ( here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

679 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