R
relative_virtue
Hi all,
I'm trying to create a function to open any file from Excel with the
default associated programme. For this, I've used a (very) slightly
tweaked version of the ShellExecute code in Microsoft's KB article
170918 (below).
The code works fine when opening most files. However, when the file in
question is an .xls file, VBA seems to get confused and hangs. No
error message, nothing - the code just gets stuck at:
StartDoc = ShellExecute(Scr_hDC, "Open", DocName,"", "C:\",
SW_SHOWNORMAL)
I have a vague inkling that this is something to do with Excel trying
to run itself while it is busy trying to run itself, but not being a
programmer, I couldn't articulate it any better than that. Does anyone
have any suggestions, short of having two separate bits of code for
Excel and non-Excel files?
Best regards,
Tristan Jakob-Hoff
'START QUOTE
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&
Function StartDoc(DocName As String) As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", DocName, _
"", "C:\", SW_SHOWNORMAL)
End Function
Public Sub OpenDoc2(Filename As String)
Dim r As Long, msg As String
r = StartDoc(Filename)
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
'END QUOTE
I'm trying to create a function to open any file from Excel with the
default associated programme. For this, I've used a (very) slightly
tweaked version of the ShellExecute code in Microsoft's KB article
170918 (below).
The code works fine when opening most files. However, when the file in
question is an .xls file, VBA seems to get confused and hangs. No
error message, nothing - the code just gets stuck at:
StartDoc = ShellExecute(Scr_hDC, "Open", DocName,"", "C:\",
SW_SHOWNORMAL)
I have a vague inkling that this is something to do with Excel trying
to run itself while it is busy trying to run itself, but not being a
programmer, I couldn't articulate it any better than that. Does anyone
have any suggestions, short of having two separate bits of code for
Excel and non-Excel files?
Best regards,
Tristan Jakob-Hoff
'START QUOTE
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&
Function StartDoc(DocName As String) As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", DocName, _
"", "C:\", SW_SHOWNORMAL)
End Function
Public Sub OpenDoc2(Filename As String)
Dim r As Long, msg As String
r = StartDoc(Filename)
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
'END QUOTE