SHBrowseForFolder in Access VBA

[Adam P. Japhet]

Anyone had luck porting the Win32 API SHBrowseForFolder in Access? I
am trying the following code and it successfully brings up the folder
browse form, but dies with error 49 "Bad DLL Calling Convention" when
it attempts to return the folder name.
Also, anyone able to get the second argument, pidlRoot, converted over
properly for use in VBA? I'm not sure how the structure is supposed
to be setup. Thanks:

My example code is below:
---
Option Compare Database
Option Explicit

Type tagBROWSEINFO
hwndOwner As Long
pidlRoot As Long
lpstrReturnFolder As String
lpstrTitle As String
lngFlags As Long
lngCallBack As Long
lngLParam As Long
intImage As Integer
End Type
Dim BROWSEINFO As tagBROWSEINFO

Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

Declare Function wapi32_lstrcpy Lib "Kernel32" Alias "lstrcpyA" (ByVal
lpDestString As String, ByVal lpSourceString As String) As Long
Declare Function wapi32_SHBrowseForFolder Lib "Shell32.DLL" Alias
"SHBrowseForFolder" (BROWSEINFO As tagBROWSEINFO)
----
Function BrowseforFolder()

Dim strReturnFolder As String, strTitle As String
Dim lngResult As Long

On Error Resume Next
BROWSEINFO.hwndOwner = Screen.ActiveForm.Hwnd
If Err Then
BROWSEINFO.hwndOwner = 0&
End If
On Error GoTo 0

strReturnFolder = Space$(255) & Chr$(0)
strTitle = "Test" & Chr$(0)

BROWSEINFO.pidlRoot = 0
BROWSEINFO.lpstrReturnFolder = wapi32_lstrcpy(strReturnFolder,
strReturnFolder)
BROWSEINFO.lpstrTitle = wapi32_lstrcpy(strTitle, strTitle)
BROWSEINFO.lngFlags = 0
BROWSEINFO.lngCallBack = 0
BROWSEINFO.lngLParam = 0
BROWSEINFO.intImage = 0

lngResult = wapi32_SHBrowseForFolder(BROWSEINFO)
MsgBox strReturnFolder

End Function

[Randy Birch]

You're trying too hard!

Try ....

'general dec's

Option Explicit
' Modified June 6 by Randy Birch

Public Type SHITEMID
cb As Long
abID As Byte
End Type

Public Type ITEMIDLIST
mkid As SHITEMID
End Type

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As
Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal
hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long

Public Const NOERROR = 0

Public Const CSIDL_DESKTOP = &H0

Declare Function SHBrowseForFolder Lib "shell32.dll" Alias
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST

Public Type BROWSEINFO
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 Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

'form
Command1_Click

lblFolder = Browser()

'form or module

Function Browser() as String

Dim bi As BROWSEINFO
Dim IDL As ITEMIDLIST

Dim r&, pidl&, path$, pos%

'Fill the BROWSEINFO structure with the needed data
'-----------------------------------------------------
'the calling app
bi.hOwner = Me.hWnd

'-----------------------------------------------------
'Pointer to the item identifier list specifying
'the location of the "root" folder to browse from.
'If NULL, the desktop folder is used.
bi.pidlRoot = 0&

'-----------------------------------------------------
'message to be displayed in the Browse dialog
bi.lpszTitle = "Select your Access Database directory"

'-----------------------------------------------------
'the type of folder to return.
bi.ulFlags = BIF_RETURNONLYFSDIRS

'-----------------------------------------------------
'show the browse folder dialog
pidl& = SHBrowseForFolder(bi)

'-----------------------------------------------------
'the dialog has closed, so parse & display the
'user's returned folder selection contained in pidl&
path$ = Space$(512)
r& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)

If r& Then
pos% = InStr(path$, Chr$(0))
Browser = Left(path$, pos - 1)
Else: Browser = ""
End If
'-----------------------------------------------------
End Function

--
Randy Birch
randy...@msn.com
Fidonet The Programer's Guild, Barrie, Ontario 1:252/128
Fidonet Bits & Bytes, Toronto Ontario 1:250/350