下記のコードに変更してください。
|
'設定されているファイルを開く
Private Sub ExFileOpen(ext As String, sfina As String)
Dim hwnd As Long
On Error GoTo ErrEnd
Select Case ext
Case "xls" 'Excelファイルを開く
Workbooks.Open Filename:=sfina
Case "exe" 'EXEファイルを実行する
Shell sfina, 1
Case Else
hwnd = GetDesktopWindow
ExKanrenFileOpen hwnd, sfina, "", "", SW_SHOWNORMAL
End Select
Exit Sub
ErrEnd:
Beep
MsgBox "ファイルオープン時エラーが発生しました。" & vbCrLf & _
"エラー内容： " & Err.Description
End Sub
|
下記のコードを追加してください。
|
'関連付けされているアプリケーションで開く
Private Declare Function ShellExecute 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 Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
'デスクトップのハンドルを取得する
Private Declare Function GetDesktopWindow Lib "user32" () As Long
'関連付けされているアプリケーションで開く
Public Sub ExKanrenFileOpen(hwnd As Long, FilePath As String, parameter As String, WorkPath As String, WindowSize As Long)
Dim ret As Long
Dim msg As String
ret = ShellExecute(hwnd, "Open", FilePath, parameter, WorkPath, WindowSize)
If ret < 31 Then 'エラー発生の場合
Select Case ret
Case 0
msg = "メモリ不足です。"
Case ERROR_FILE_NOT_FOUND
msg = "ファイルが見つかりません。"
Case ERROR_PATH_NOT_FOUND
msg = "ファイルのパスが見つかりません。"
Case Else
msg = ret & "その他のエラー"
End Select
MsgBox msg, vbCritical, "Excelランチャー"
End If
End Sub
|
|
