Opening Excel & PDF files from a form (1 Viewer)

[dongilles]

Hello all,

a couple of years ago you helped me open documents from a access form
link to topic

But now I am running into the problem that this does not work for everyone anymore.
A collegue of mine as a new PC and now runs offic365 in 64 bits (what I assume is the problem)

Anyone here who has experienced the same problem?
And knows the solution?

 

[Uncle Gizmo]

It sounds like you might be trying to use 32-bit code in a 64-bit environment without using ptrSafe.

For more information see the Microsoft link here:-

PtrSafe keyword (VBA)

Office VBA reference topic

docs.microsoft.com

if this doesn't help, then you will need to repost. But please, provide more information! Your initial offering is lacking in detail which would be very handy for anyone trying to answer your question.

 

[arnelgp]

here is the complete code for x32/x64 msa.

Option Compare Database
Option Explicit


#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As LongPtr
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
#Else
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
#End If
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)
#If VBA7 Then
    Dim r As LongPtr
#Else
    Dim r As Long
#End If
    Dim 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

#If VBA7 Then
Private Function StartDoc(psDocName As String) As LongPtr
    Dim Scr_hDC As LongPtr
#Else
Private Function StartDoc(psDocName As String) As Long
    Dim Scr_hDC As Long
#End If
    Scr_hDC = GetDesktopWindow()
    StartDoc = ShellExecute(Scr_hDC, "Open", psDocName, "", "C:\", SW_SHOWNORMAL)
End Function

 

[Gasman]

@arnelgp How do you know what to change to LongPtr in the parentheses and what not to change?

EG hwnd is changed to LongPtr but FsShowCmd is not.
Admittedly that is all the Longs in that API, but what if there were several more.?

Is there some sort of rule to apply?

TIA

 

[arnelgp]

mr.gasman,
check this API declarations list.

 

[Gasman]

mr.gasman,
check this API declarations list.

Thank you arnel.

 

[dongilles]

here is the complete code for x32/x64 msa.
------

Thank you this works like a charm!