R
rapple
I'm trying to get Excel VBA to fire up the relevant program for an
registered file type. Shellexecute is mentioned in many places as th
solution for this and indeed it works fine.
Except...
that when I select an Excel file type it just hangs there.
Can anyone explain to me why?
I'm not really a coder, just someone that throws bits together an
experiments but I can see no obvious reason why this should fail so
am guessing that it has something to do with the way that Excel use
the API call.
... why don't I just open the file in Excel? Well, I wanted to keep th
code simple rather than have to detect that it was an Excel fil
selected and treat it differently. Also unless I understand why i
doesn't work I am concerned that it might happen with another file typ
and application.
Within the code the getdesktop window call is in there simply because
saw it in one other example and thought that it might make a differenc
(not really understanding when the parameters can be dummied out an
window handles aren't often ones that you can miss out) but it made n
difference.
Thanks.
Code used to achieve this below.
-----------------------------------
Public Const SW_SHOWNORMAL = 1
Public Const SE_ERR_FNF = 2&
Public Const SE_ERR_PNF = 3&
Public Const SE_ERR_ACCESSDENIED = 5&
Public Const SE_ERR_OOM = 8&
Public Const SE_ERR_DLLNOTFOUND = 32&
Public Const SE_ERR_SHARE = 26&
Public Const SE_ERR_ASSOCINCOMPLETE = 27&
Public Const SE_ERR_DDETIMEOUT = 28&
Public Const SE_ERR_DDEFAIL = 29&
Public Const SE_ERR_DDEBUSY = 30&
Public Const SE_ERR_NOASSOC = 31&
Public Const ERROR_BAD_FORMAT = 11&
Private Declare Function apiShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Sub Fred()
'
' Keyboard Shortcut: Ctrl+r
'
Dim sfilename2 As String
Dim X As Integer
Dim lRet As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
sfilename = Application.GetOpenFilename("All files (*.*), *.*", , "Fin
required file")
' To Exit if Cancel was pressed
If sfilename = False Then Exit Sub
sfilename2 = sfilename
lRet = apiShellExecute(Scr_hDC, "Open", sfilename2, vbNullString
vbNullString, SW_SHOWNORMAL)
If lRet <= 32 Then
'There was an error
Select Case lRet
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 Su
registered file type. Shellexecute is mentioned in many places as th
solution for this and indeed it works fine.
Except...
that when I select an Excel file type it just hangs there.
Can anyone explain to me why?
I'm not really a coder, just someone that throws bits together an
experiments but I can see no obvious reason why this should fail so
am guessing that it has something to do with the way that Excel use
the API call.
... why don't I just open the file in Excel? Well, I wanted to keep th
code simple rather than have to detect that it was an Excel fil
selected and treat it differently. Also unless I understand why i
doesn't work I am concerned that it might happen with another file typ
and application.
Within the code the getdesktop window call is in there simply because
saw it in one other example and thought that it might make a differenc
(not really understanding when the parameters can be dummied out an
window handles aren't often ones that you can miss out) but it made n
difference.
Thanks.
Code used to achieve this below.
-----------------------------------
Public Const SW_SHOWNORMAL = 1
Public Const SE_ERR_FNF = 2&
Public Const SE_ERR_PNF = 3&
Public Const SE_ERR_ACCESSDENIED = 5&
Public Const SE_ERR_OOM = 8&
Public Const SE_ERR_DLLNOTFOUND = 32&
Public Const SE_ERR_SHARE = 26&
Public Const SE_ERR_ASSOCINCOMPLETE = 27&
Public Const SE_ERR_DDETIMEOUT = 28&
Public Const SE_ERR_DDEFAIL = 29&
Public Const SE_ERR_DDEBUSY = 30&
Public Const SE_ERR_NOASSOC = 31&
Public Const ERROR_BAD_FORMAT = 11&
Private Declare Function apiShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Sub Fred()
'
' Keyboard Shortcut: Ctrl+r
'
Dim sfilename2 As String
Dim X As Integer
Dim lRet As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
sfilename = Application.GetOpenFilename("All files (*.*), *.*", , "Fin
required file")
' To Exit if Cancel was pressed
If sfilename = False Then Exit Sub
sfilename2 = sfilename
lRet = apiShellExecute(Scr_hDC, "Open", sfilename2, vbNullString
vbNullString, SW_SHOWNORMAL)
If lRet <= 32 Then
'There was an error
Select Case lRet
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 Su