【VBA】ファイルを開く（拡張子参照）

プログラム・IT

【VBA】ファイルを開く（拡張子参照）

2022年6月18日(土曜日)

今回は、拡張子に応じたアプリケーションを起動する方法を用いてVBAでファイルを開く方法を紹介します。

前回紹介したテキストファイルの保存とあわせて利用することで、マクロの実行結果のリポートをまずはファイルとして保存し、すぐに開いて見せることができます。

【VBA】テキストファイル保存（UTF8）

プログラム・IT

▼

もちろんリポートをダイアログ（メッセージボックス）で表示することもでき、その方が手軽ですが、ダイアログに表示されている文章を記録したり、コピペして使うことは容易ではありません。しかしテキストファイルに一度保存しておくことで、そこからコピペしてメールで誰かに伝えたり、リポートの内容をあとで再確認しやすくなるというメリットがあります。

エラーがない場合はダイアログで知らせ、エラーがある場合はテキストファイルに保存したうえで表示して見せる、という使い方も可能です。

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

関数：ShellByExt

まずは以下のコードを標準モジュールにコピペして、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

実行例

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

Sub VBATest_ShellByExt()
'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