Excelでランチャーソフトを作ってみよう

'設定されているファイルを開く
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

下記のVBAコードを追加してください。

'関連付けされているアプリケーションで開く
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