• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1045
  • Last Modified:

VB6 'browse for folder' button

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: http://www.vbaccelerator.com/home/vb/Code/Libraries/Common_Dialogs/Folder_Browser/article.asp
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.  

2 Solutions
Shamelessly taken from: http://www.xtremevbtalk.com/showpost.php?p=953820&postcount=8

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

If you have ongoing VB6 needs I highly recommend Matthew Curland's Advanced VB6, Power Techniques for Everyday Programmers.
galaxy7Author Commented:
OK, thanks.  there r 3 versions on that site, so I will try all 3, and report back here.  
What Kind of Coding Program is Right for You?

There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.

If you want something simple, you can create your own using the intrinsic Dirve and Dir boxes. Here is an example.
galaxy7Author Commented:
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…?
galaxy7Author Commented:
@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.

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

Open in new window

galaxy7Author Commented:
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)
galaxy7Author Commented:
 (PS:@ MedievalWarrior I also tried your idea at the end, but it didn't seem to have an effect. Thanks anyway; a good idea.)
galaxy7Author Commented:
PS: I awarded points to both solutions.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now