SHBrowseForFolder

[Peter Uebers]

I use the API-function SHBrowseForFolder to select a folder.
Now, I want to set the previous selection before
calling the browser-window.
I think I've to declare a callback function BrowseCallbackProc.
Can someone give me some sample code about declaring this callback-function.

Thanx
Peter

[Sharathms]

Hi,
check this out. (i dont know where i got this from)
Cheers,
Sharath


public Function BrowseForFolder(byval hwdParent as Long, byval strInstruction as string, optional byval strInitialValue as string) as string

Dim lpIDList as Long 'Long pointer. Used in the API call
Dim strBuffer as string 'Buffer: Used to Hold the user selected path
Dim tBrowseInfo as BrowseInfo 'Browse for dialog structure : Used to pass all the information


If strInitialValue <> "" then
'set a modular variable (this will be used in the function BrowseCallbackProc)
mstrCurrentDirectory = strInitialValue & vbNullChar
End If

'Populate the structre
With tBrowseInfo
'set the Parent
.hWndOwner = hwdParent
'set the instruction: pointer needed to the structure
.lpszTitle = lstrcat(strInstruction, "")
'set the flags (Browse for Folders + Start in Desk Top + Show label which will be used to display selected text)
.ulFlags = BIF_RETURNONLYFSDIRS + Desktop '+ IncludeStatusText
'set the call function
.lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc) 'get address of function.
End With
'All the API
lpIDList = SHBrowseForFolder(tBrowseInfo)
'User selected OK
If (lpIDList) then
'Build a buffer to hold the path
strBuffer = Space(MAX_PATH)
'get the User selected folder
SHGetPathFromIDList lpIDList, strBuffer
'Convert from C style string to VB Style string
strBuffer = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
'set the return value
BrowseForFolder = strBuffer
else
'User cancelled: return an empty string
BrowseForFolder = ""
End If

End Function



private Function BrowseCallbackProc(byval hWnd as Long, byval uMsg as Long, byval lp as Long, byval pData as Long) as Long

Dim lpIDList as Long
Dim ret as Long
Dim sBuffer as string
on error resume next 'Sugested by MS to prevent an error from
'propagating back into the calling process.

Select Case uMsg


Case BFFM_INITIALIZED
'Window Message is Intialisation
'set the intial path
Call SendMessage(hWnd, BFFM_SETSELECTION, 1, mstrCurrentDirectory)

Case BFFM_SELCHANGED
'Window Message is selection changed (user has selected a folder)
'Build a buffer
sBuffer = Space(MAX_PATH)
'get the user selected path
ret = SHGetPathFromIDList(lp, sBuffer)

If ret = 1 then
'set the label with user selected path
Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
End If

End Select
'Always return 0 (success) . or else Overflow error will occur
BrowseCallbackProc = 0

End Function




private Function GetAddressofFunction(add as Long) as Long
GetAddressofFunction = add
End Function

[Peter Uebers]

Hi Sharat,

i can't use your code cause there are some
missing definitions. (BFFM_INITIALIZED, etc.)

Can u post it?

Thanx
Peter

[Sharathms]

Sorry about that. i did not realise it.
its too big. use what ever you want.
cheers,
Sharath

Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) 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 Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

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

Private mstrCurrentDirectory As String 'The current directory


Private Enum trBrowseOption
ReturnFileSystemFoldersOnly = &H1
DontGoBelowDomain = &H2
IncludeStatusText = &H4
BrowseForComputer = &H1000
BrowseForPrinter = &H2000
BrowseIncludeFiles = &H4000
ReturnFileSystemAncestors = &H8
End Enum
Private Enum trStartOption
Desktop = &H0
Internet = &H1
Programs = &H2
ControlsFolder = &H3
Printers = &H4
Personal = &H5
Favorites = &H6
StartUp = &H7
Recent = &H8
SendTo = &H9
RecycleBin = &HA
StartMenu = &HB
DesktopDirectory = &H10
Drives = &H11
Network = &H12
Nethood = &H13
Fonts = &H14
Templates = &H15
Common_StartMenu = &H16
Common_Programs = &H17
Common_StartUp = &H18
Common_DesktopDirectory = &H19
ApplicationData = &H1A
PrintHood = &H1B
AltStartUp = &H1D
Common_AltStartUp = &H1E
Common_Favorites = &H1F
InternetCache = &H20
Cookies = &H21
History = &H22
End Enum