[AccessD] Code to get a directory name via navigation

Gustav Brock gustav at cactus.dk
Sat Mar 29 12:20:31 CST 2003


Hi Arthur

So what does your code look like?
How do you set/pick this <AddressOf BrowseCallbackProcStr> variable?

/gustav


> Doesn't fail for me either (winXP) ..


>> '*******************************
>> Option Compare Database
>> Option Explicit

>> Private Const BIF_RETURNONLYFSDIRS = 1
>> Private Const BIF_DONTGOBELOWDOMAIN = 2
>> Private Const MAX_PATH = 260

>> 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
>>    strTitle As String
>>    ulFlags As Long
>>    lpfnCallback As Long
>>    lParam As Long
>>    iImage As Long
>> End Type

>> Public Const LMEM_FIXED = &H0   'added
>> Public Const LMEM_ZEROINIT = &H40   'added
>> Public Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)   'added

>> Public Declare Function LocalAlloc Lib "kernel32" _
>>  (ByVal uFlags As Long, _
>>     ByVal uBytes As Long) As Long   'added

>> Public Declare Function LocalFree Lib "kernel32" _
>>   (ByVal hMem As Long) As Long  'added

>> Public Declare Function lstrcpyA Lib "kernel32" _
>>   (lpString1 As Any, lpString2 As Any) As Long  'added

>> Public Declare Function lstrlenA Lib "kernel32" _
>> (lpString As Any) As Long   'added

>> Public Declare Sub CopyMemory Lib "kernel32" _
>>     Alias "RtlMoveMemory" _
>>    (pDest As Any, _
>>     pSource As Any, _
>>     ByVal dwLength As Long) 'added

>> Public Const BFFM_INITIALIZED = 1   'added
>> Public Const WM_USER = &H400    'added

>> 'Selects the specified folder. If the wParam
>> 'parameter is FALSE, the lParam parameter is the
>> 'PIDL of the folder to select , or it is the path
>> 'of the folder if wParam is the C value TRUE (or 1).
>> 'Note that after this message is sent, the browse
>> 'dialog receives a subsequent BFFM_SELECTIONCHANGED
>> 'message.
>> Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102) Public Const 
>> BFFM_SETSELECTIONW As Long = (WM_USER + 103)

>> 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 Function GetFolder(strPath As String, Optional strTitle As 
>> String = "Select Folder") As String Dim lpIDList As Long
>> Dim sBuffer As String
>> Dim szTitle As String
>> Dim lpPath As Long
>> Dim tBrowseInfo As BrowseInfo

>> With tBrowseInfo
>>    .hWndOwner = Application.hWndAccessApp
>>    .pidlRoot = 0
>>    .strTitle = strTitle
>>    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
>>    .lpfnCallback = FARPROC(AddressOf BrowseCallbackProcStr)
>>     lpPath = LocalAlloc(LPTR, Len(strPath) + 1)
>>     CopyMemory ByVal lpPath, ByVal strPath, Len(strPath) + 1
>>     .lParam = lpPath
>> End With

>> lpIDList = SHBrowseForFolder(tBrowseInfo)

>> If (lpIDList) Then
>>    sBuffer = Space(MAX_PATH)
>>    SHGetPathFromIDList lpIDList, sBuffer
>>    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1) End If

>> GetFolder = sBuffer

>> End Function

>> Private Function BrowseCallbackProcStr(ByVal hWnd As Long, _
>>                                       ByVal uMsg As Long, _
>>                                       ByVal lParam As Long, _
>>                                       ByVal lpData As Long) As Long

>>   'Callback for the Browse STRING method.

>>   'On initialization, set the dialog's
>>   'pre-selected folder from the pointer
>>   'to the path allocated as bi.lParam,
>>   'passed back to the callback as lpData param.
>>    Select Case uMsg
>>       Case BFFM_INITIALIZED
>>          Call SendMessage(hWnd, BFFM_SETSELECTIONA, True, ByVal lpData)
>>          Case Else
>>    End Select

>> End Function

>> Private Function FARPROC(pfn As Long) As Long
>>   'This workaround is needed as you can't assign
>>   'AddressOf directly to a member of a user-
>>   'defined type, but you can assign it to another
>>   'long and use that (as returned here)
>>   FARPROC = pfn
>> End Function
>> '*************************************************



More information about the AccessD mailing list