Opening Excel & PDF files using the shell command (1 Viewer)

[dongilles]

Hello,

From my database I open a lot of documents using the following code:

Private Sub OPEN_FILE_Click()
Dim stAppName, stApp, stPath, stVersion, stFile, stExt As String

stFile = Me.DOCUMENT_CODE.Value
stPath = Me.DOCUMENT_FILE_LOCATIE.Value
stVersion = Me.DOCUMENT_VERSION.Value
stApp = Me.APP.Value
stExt = Me.APP_EXTENSION.Value
stAppName = stApp & " " & stPath & stFile & "" & stVersion & stExt
Call Shell(stAppName, 1)

End Sub

The Me.APP.Value come from an other table with the following
C:\Program Files (x86)\Microsoft Office\Office14\EXCEL.exe
C:\Program Files\Microsoft Office\Office14\WINWORD.exe
C:\Program Files (x86)\Adobe\Acrobat 10.0\Acrobat\Acrobat.exe

The problem is that I now have a new version of Office and the links do not work anymore, but because other in the company also use the database and still have the old version I need an alternative.

For Word the problem is solved by removing the path and put only WINWORD.exe instead.

Is there something simular for Excel and PDF files?

 

[Ranman256]

You dont need the shell. That requires you know the path to the apps.
THIS doesnt. It opens any app via the document path.

Paste this code into a module, and it will open ANY file in its native application.
usage: OpenNativeApp "c:\folder\file.pdf"
will open it in acrobat
and
OpenNativeApp ME.txtBox
will open the doc in Word if the item in txtBox is C:\myfile.doc

'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

 

[dongilles]

Thanks for the help, except I cant get it to work. (I am still leaning to work with access and esspecially VB)

Could you please help me some more?

As a test I copied the code into a general module

Then a button with the following:
Private Sub OPEN_FILE_Click()

OpenNativeApp "c:\folder\file.pdf"

End Sub

But then I get the error
sub or function not defined

and the it marks:
Public Sub OpenNativeApp(ByVal psDocName As String)

 

[dongilles]

Is there no one who can help me?

 

[JHB]

Is there no one who can help me?

Try Call OpenNativeApp("c:\folder\file.pdf")

 

[dongilles]

Sadly the error is the same

 

[PeterF]

Did you name the module the same as the function in it?
Access doesn't like that.

 

[dongilles]

No I do not have the same name. Even changed the name to make sure this is not the problem

 

[dongilles]

Made a new quick database. and I have the same problem

Sadly I cannot post links yet on the forum

 

[dongilles]

just one more post till I can post links
Sorry for the spam

 

[dongilles]

Here is the link to the quicklymade test

https://www.dropbox.com/s/oennfh3tc8bhx9p/Database2.accdb?dl=0

 

[Frothingslosh]

What's happening is that Ranman included a call to StartDoc:

r = [COLOR=red]StartDoc[/COLOR](psDocName)

That's causing the 'undefined function error', even though the debugger is highlighting

Public Sub OpenNativeApp(ByVal psDocName As String)

If I recall correctly, isn't StartDoc a function or procedure in one of the C variants?

 

[JHB]

The below code is missing in the part Ranman256 posted, paste it at the end of the code in the module.

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

 

[dongilles]

Thanks I did not notice that some of the code was missing. Now it works.


This is the complete code

'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