Error in Open/Browse folder code in access 2010

[stigmatized]

Hi guys,



After the installation of the Access 2010, I am getting an error in my vba code in opening a folder. I think there is a compatibility issue between 2007 and 2010.

This is the code that I used in 2007 version and it works fine.

Private 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

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Const BIF_RETURNONLYFSDIRS = &H1

Public Function BrowseFolder(szDialogTitle As String) As String
Dim x As Long
Dim bi As BROWSEINFO
Dim dwIList As Long
Dim szPath As String
Dim wPos As Integer
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If x Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

The error is in this line

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
 Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

I just copied this code in the a forum to open a folder and I have no idea how to correct this.

Please help me on this.


Stigmatized

[ranman256]

I use this. It can be used for ANYTHING.
Pass it a file path, it will open it in file browser.
Pass it a word doc, it will open Word....etc.

Put the code in a module and call: OpenNativeApp "c:\folder\"

'Attribute VB_Name = "modNativeApp"
Option Compare Database
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&

Public Sub OpenNativeApp(ByVal psDocName As String)
Dim r As Long, msg As String
r = StartDoc(psDocName)
If r <= 32 Then
    'There was an error
    Select Case r
        Case SE_ERR_FNF
            msg = "File not found"
        Case SE_ERR_PNF
            msg = "Path not found"
        Case SE_ERR_ACCESSDENIED
            msg = "Access denied"
        Case SE_ERR_OOM
            msg = "Out of memory"
        Case SE_ERR_DLLNOTFOUND
            msg = "DLL not found"
        Case SE_ERR_SHARE
            msg = "A sharing violation occurred"
        Case SE_ERR_ASSOCINCOMPLETE
            msg = "Incomplete or invalid file association"
        Case SE_ERR_DDETIMEOUT
            msg = "DDE Time out"
        Case SE_ERR_DDEFAIL
            msg = "DDE transaction failed"
        Case SE_ERR_DDEBUSY
            msg = "DDE busy"
        Case SE_ERR_NOASSOC
            msg = "No association for file extension"
        Case ERROR_BAD_FORMAT
            msg = "Invalid EXE file or error in EXE image"
        Case Else
            msg = "Unknown error"
    End Select
'    MsgBox msg
End If
End Sub
Private Function StartDoc(psDocName As String) As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", psDocName, "", "C:\", SW_SHOWNORMAL)
End Function

[stigmatized]

hi ranman,

I tried to put this code to my vba but still there is an error was in this line

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

it turns red the moment I put the code in the editor.


stigmatized

[June7]

Was this running under 2007 on the same computer? "user32" expects a 32-bit operating system. When we upgraded to Windows7 and Access2010 and some users given 64-bit systems, I had to change code to use PtrSafe keyword.

Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal wRevert As Long) As Long
Private Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long

For alternative to Shell, consider http://allenbrowne.com/func-GoHyperlink.html
or use FilePicker dialog.

[stigmatized]

Was this running under 2007 on the same computer? "user32" expects a 32-bit operating system. When we upgraded to Windows7 and Access2010 and some users given 64-bit systems, I had to change code to use PtrSafe keyword.

Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal wRevert As Long) As Long
Private Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long

For alternative to Shell, consider http://allenbrowne.com/func-GoHyperlink.html
or use FilePicker dialog.

Yes. But my problem is if this will be open to 2007 with the 64-bit PtrSafe keyword, it will give an error. Some of my users are having 2007 version.

I think I will use the FilePicker dialog instead.

Thanks!!