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 >> '*************************************************