File Browser in VB 1

[smada80]

Hi all

I looking for the code to display a standard windows folder browser in VB6, i.e. a tree structure where you can choose a directory to save into.

Would appreciate any help you could give!

Thanks
Matt

 

[LPlates]

Option Explicit

Public Type BROWSEINFOTYPE
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBROWSEINFOTYPE As BROWSEINFOTYPE) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Public Const WM_USER = &H400

Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Public Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Public Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Public Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Public Const LPTR = (&H0 Or &H40)

Public Function BrowseForFolder(selectedPath As String) As String
Dim Browse_for_folder As BROWSEINFOTYPE
Dim itemID As Long
Dim selectedPathPointer As Long
Dim TmpPath As String * 256
With Browse_for_folder
.hOwner = Form1.hWnd
.lpszTitle = "Browse for folders"
.lpfn = FunctionPointer(AddressOf BrowseCallbackProcStr)
selectedPathPointer = LocalAlloc(LPTR, Len(selectedPath) + 1)
CopyMemory ByVal selectedPathPointer, ByVal selectedPath, Len(selectedPath) + 1
.lParam = selectedPathPointer
End With
itemID = SHBrowseForFolder(Browse_for_folder)
If itemID Then
If SHGetPathFromIDList(itemID, TmpPath) Then
BrowseForFolder = Left$(TmpPath, InStr(TmpPath, vbNullChar) - 1)
End If
Call CoTaskMemFree(itemID)
End If
Call LocalFree(selectedPathPointer)
End Function

Public Function BrowseCallbackProcStr(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
If uMsg = 1 Then
Call SendMessage(hWnd, BFFM_SETSELECTIONA, True, ByVal lpData)
End If
End Function

Public Function FunctionPointer(FunctionAddress As Long) As Long
FunctionPointer = FunctionAddress
End Function




Private Sub Command1_Click()
Dim TmpPath As String
Dim path As String
TmpPath = Label3
If Len(TmpPath) > 0 Then
If Not Right$(TmpPath, 1) <> &quot;\&quot; Then TmpPath = Left$(TmpPath, Len(TmpPath) - 1) ' Remove &quot;\&quot; if the user added
End If
TmpPath = BrowseForFolder(TmpPath) ' Browse for folder
If TmpPath = &quot;&quot; Then
path = &quot;&quot; ' If the user pressed cancel
Else
path = TmpPath ' If the user selected a folder
End If
Label3 = path
End Sub

 

[nicsin]

Hi smada80,

you should use the common dialogue control. Search this site and you will find the info you want.

regards,
nicsin

 

[LPlates]

>you should use the common dialogue control. Search this site and you will find the info you want.


No, you want folder browse not file browse, in which case you would use some more API so you didnt have to reference the common dialog control