【VBA関数】ファイルを開く（拡張子に応じたアプリケーション起動）

今回紹介するのは、指定したファイルを開く関数です。VBA標準のShell関数とは異なり、拡張子に関連付けられたアプリケーションでファイルを開くのでEXEファイルに限らず実行できます。

関数：ShellByExt

'API宣言(ShellExecuteA)'
Declare PtrSafe 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
Public Const ERROR_FILE_NOT_FOUND = 2
Public Const ERROR_PATH_NOT_FOUND = 3
Public Const ERROR_BAD_FORMAT = 11
Public Const SE_ERR_ACCESSDENIED = 5
Public Const SE_ERR_ASSOCINCOMPLETE = 27
Public Const SE_ERR_DDEBUSY = 30
Public Const SE_ERR_DDEFAIL = 29
Public Const SE_ERR_DDETIMEOUT = 28
Public Const SE_ERR_DLLNOTFOUND = 32
Public Const SE_ERR_FNF = 2
Public Const SE_ERR_NOASSOC = 31
Public Const SE_ERR_OOM = 8
Public Const SE_ERR_PNF = 3
Public Const SE_ERR_SHARE = 26

Public Function ShellByExt(ByRef aPath As String, Optional ByRef aArgs As String, Optional ByRef aReturnErrorComment As String) As Boolean
'ファイル実行(拡張に応じたアプリケーション起動)'
Dim vReturn As Long
   vReturn = ShellExecute(0, vbNullString, aPath, aArgs, CurDir, 1)

   Select Case vReturn
   Case 0, SE_ERR_OOM
       aReturnErrorComment = "メモリーが不足しています。"
   Case ERROR_FILE_NOT_FOUND
       aReturnErrorComment = "ファイルが見つかりません。"
   Case ERROR_PATH_NOT_FOUND, SE_ERR_PNF
       aReturnErrorComment = "パスが見つかりません。"
   Case ERROR_BAD_FORMAT
       aReturnErrorComment = "EXEファイルが無効です。"
   Case SE_ERR_ACCESSDENIED
       aReturnErrorComment = "アクセスを拒否されました。"
   Case SE_ERR_ASSOCINCOMPLETE
       aReturnErrorComment = "ファイル名の関連付けが無効です。"
   Case SE_ERR_DDEBUSY
       aReturnErrorComment = "DDEトランザクションを完了できませんでした。"
   Case SE_ERR_DDEFAIL
       aReturnErrorComment = "DDEトランザクションが失敗しました。"
   Case SE_ERR_DDETIMEOUT
       aReturnErrorComment = "タイムアウトによりDDEトランザクションを完了できませんでした。"
   Case SE_ERR_DLLNOTFOUND
       aReturnErrorComment = "DLLが見つかりませんでした。"
   Case SE_ERR_FNF
       aReturnErrorComment = "ファイルが見つかりませんでした。"
   Case SE_ERR_NOASSOC
       aReturnErrorComment = "ファイル拡張子に関連付けられたアプリケーションがありません。"
   Case SE_ERR_SHARE
       aReturnErrorComment = "共有違反が発生しました。"
   Case Is > 32
       '(成功)'
   Case Else
       aReturnErrorComment = "その他のエラーです。(" & vReturn & ")"
   End Select

   If vReturn > 32 Then
       ShellByExt = True '成功'
   Else
       ShellByExt = False '失敗'
   End If

End Function

実行例

前回紹介した"TextSaveUTF8N"関数を利用してTXTファイルを保存し、その直後にファイルを開いてみます。

TXTファイルに関連付けられたアプリケーション（Windowsの標準設定では『メモ帳』）で、指定ファイルが開きます。WordでもExcelでもPowerPointでも実行できます。

Sub VBATest_ShellByExt()

Dim vPath As String 'パスを指定する(必須)'
Dim vArguments As String '実行時の引数を指定する(省略可)'
Dim vErrComment As String 'エラー発生時のコメント(戻り値として取得)'

Dim vFullText As String '保存するテキストの内容を指定'

   'パスを指定'
   vPath = ".\test.txt"
   vArguments = ""

   'テキストファイル保存の準備'
   vFullText = "TextSaveUTF8Nを紹介した前回の記事もあわせてご覧ください。" & vbCrLf
   vFullText = vFullText & "https://note.com/hpnm/n/n3783531c0d14"

   'テキストファイル保存を実行'
   If TextSaveUTF8N(vPath, vFullText) = False Then
       Exit Sub '失敗したら終了'
   End If

   '実行'
   If ShellByExt(vPath, vArguments, vErrComment) = False Then
       Call MsgBox("失敗: " & vErrComment, vbOKOnly)
   End If

End Sub

オマケ。URLを指定するとブラウザが開きます。

'URLを開く(ブラウザが起動する)'
Call ShellByExt("https://note.com/hpnm/n/n3783531c0d14")

余談

マクロを実行した際にドキュメントの内容に不備がある場合、普通はダイアログを表示して問題がある個所を指摘します。でもダイアログに問題点を列挙されてもコピペできないし不便なんですよね。

そこでフォームを開いて、フォーム上に配置したテキストボックスにエラーを表示すればいい……と思ったら、いまだにVBAのテキストボックスはマウスのホイールが効かない！ たくさんの問題点を列挙する場合に、これは非常につらい……。

ネットで検索するとマウスのホイールを認識させたり、あるいはフォーム上にWebBrowserコントロール（これはホイールを認識する）を配置するといった回避策が提示されていますが、どちらも難易度が高い！

そこで、なにか簡単な方法はないかな……と考えた結果、「テキストファイルに保存して、それを開けばいいよね」という結論に達したのでした。

エラーがないときは普通にダイアログで結果を知らせ、エラーがあるときは日時を加えたファイル名（例えばBook1.xlsm_20211231_2355.txt）にエラー内容を保存すると、あとで過去の失敗を振り返れて便利です。

エラー表示のためにフォームを作るのもまあまあ面倒ですし、テキストファイル保存＆開くが簡単かつ便利なので、VBAのテキストボックスがホイールに対応していなくて逆に良かった（!?）かもしれません。