Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

VB6 'browse for folder' button

Posted on 2011-03-02
10
Medium Priority
?
1,010 Views
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:
HTTP://WWW.VBFORUMS.COM/SHOWTHREAD.PHP?P=1592686#POST1592686
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.  



GsSimpleBrowseFolder.zip
0
Comment
Question by:galaxy7
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
10 Comments
 
LVL 9

Assisted Solution

by:rawinnlnx9
rawinnlnx9 earned 800 total points
ID: 35024235
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
  Else
    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
  bi.ulFlags = BIF_RETURNONLYFSDIRS
  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
  If uMsg = BFFM_INITIALIZED Then
    SendMessage hwnd, BFFM_SETSELECTIONA, True, ByVal sData
  End If
End Function

Open in new window


USAGE:

' 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

0
 
LVL 9

Expert Comment

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

Author Comment

by:galaxy7
ID: 35024523
OK, thanks.  there r 3 versions on that site, so I will try all 3, and report back here.  
0
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

by:
GrahamSkan earned 1200 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.
Form1.frm
0
 

Author Comment

by:galaxy7
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…?
0
 

Author Comment

by:galaxy7
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.
Thanks.
0
 
LVL 5

Expert Comment

by:MedievalWarrior
ID: 35028142
Hi,

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

Open in new window

0
 

Author Closing Comment

by:galaxy7
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)
0
 

Author Comment

by:galaxy7
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.)
0
 

Author Comment

by:galaxy7
ID: 35041441
PS: I awarded points to both solutions.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
The viewer will learn how to clear a vector as well as how to detect empty vectors in C++.
The viewer will be introduced to the member functions push_back and pop_back of the vector class. The video will teach the difference between the two as well as how to use each one along with its functionality.

670 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