【解決】Excel 2019 for MacのVBAにて、複数ファイルを選択する方法

Googleアドセンス

◆お知らせ◆

Macでマクロを実行して、複数ファイルを選択できるようにする方法

解決の糸口は、マイクロソフトの公式ページに！

こちらに解決の糸口となる情報が書かれていました。

参考Excel for Windows および Excel for the Mac でプログラムによってファイルを選択する
マイクロソフト

VBA コードと Apple Script を組み合わせて使用すれば、同じ操作を実行できます。これを行うには、次の説明に従って、Apple Script 文字列を作成し、その文字列を VBA MacScript 関数と実行します。
マイクロソフト公式ページ

どうやらVBAコードとApple Scriptを組み合わせれば、MacでもGetOpenFilenameでワイルドカードを使用したり、複数ファイルを選択したりすることが可能になる、とのこと。

サンプルコードはそのまま使える？

サンプルコード

VBA

' Windowsでファイル選択ダイアログを表示する
Sub Select_File_Or_Files_Windows()
        Dim SaveDriveDir As String
        Dim MyPath As String
        Dim Fname As Variant
        Dim N As Long
        Dim FnameInLoop As String
        Dim mybook As Workbook

        ' Save the current directory.
        SaveDriveDir = CurDir

        ' Set the path to the folder that you want to open.
        MyPath = Application.DefaultFilePath

        ' You can also use a fixed path.
        'MyPath = "C:\Users\Ron de Bruin\Test"

        ' Change drive/directory to MyPath.
        ChDrive MyPath
        ChDir MyPath

        ' Open GetOpenFilename with the file filters.
        Fname = Application.GetOpenFilename( _
                FileFilter:="Excel 97-2003 Files (*.xls), *.xls", _
                Title:="Select a file or files", _
                MultiSelect:=True)

        ' Perform some action with the files you selected.
        If IsArray(Fname) Then
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
            End With

            For N = LBound(Fname) To UBound(Fname)

                ' Get only the file name and test to see if it is open.
                FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
                If bIsBookOpen(FnameInLoop) = False Then

                    Set mybook = Nothing
                    On Error Resume Next
                    Set mybook = Workbooks.Open(Fname(N))
                    On Error GoTo 0

                    If Not mybook Is Nothing Then
                        MsgBox "You opened this file : " & Fname(N) & vbNewLine & _
                               "And after you press OK, it will be closed" & vbNewLine & _
                               "without saving. You can replace this line with your own code."
                        mybook.Close SaveChanges:=False
                    End If
                Else
                    MsgBox "We skipped this file : " & Fname(N) & " because it is already open."
                End If
            Next N
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
        End If

        ' Change drive/directory back to SaveDriveDir.
        ChDrive SaveDriveDir
        ChDir SaveDriveDir
End Sub



' Macでファイル選択ダイアログを表示する
Sub Select_File_Or_Files_Mac()
        Dim MyPath As String
        Dim MyScript As String
        Dim MyFiles As String
        Dim MySplit As Variant
        Dim N As Long
        Dim Fname As String
        Dim mybook As Workbook

        On Error Resume Next
        MyPath = MacScript("return (path to documents folder) as String")
        'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"

        ' In the following statement, change true to false in the line "multiple 
        ' selections allowed true" if you do not want to be able to select more 
        ' than one file. Additionally, if you want to filter for multiple files, change 
        ' {""com.microsoft.Excel.xls""} to 
        ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
        ' if you want to filter on xls and csv files, for example.
        MyScript = _
        "set applescript's text item delimiters to "","" " & vbNewLine & _
                   "set theFiles to (choose file of type " & _
                 " {""com.microsoft.Excel.xls""} " & _
                   "with prompt ""Please select a file or files"" default location alias """ & _
                   MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
                   "set applescript's text item delimiters to """" " & vbNewLine & _
                   "return theFiles"

        MyFiles = MacScript(MyScript)
        On Error GoTo 0

        If MyFiles <> "" Then
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
            End With

            MySplit = Split(MyFiles, ",")
            For N = LBound(MySplit) To UBound(MySplit)

                ' Get the file name only and test to see if it is open.
                Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), Application.PathSeparator, , 1))
                If bIsBookOpen(Fname) = False Then

                    Set mybook = Nothing
                    On Error Resume Next
                    Set mybook = Workbooks.Open(MySplit(N))
                    On Error GoTo 0

                    If Not mybook Is Nothing Then
                        MsgBox "You open this file : " & MySplit(N) & vbNewLine & _
                               "And after you press OK it will be closed" & vbNewLine & _
                               "without saving, replace this line with your own code."
                        mybook.Close SaveChanges:=False
                    End If
                Else
                    MsgBox "We skipped this file : " & MySplit(N) & " because it Is already open."
                End If
            Next N
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
        End If
    End Sub


' Windowsでファイル選択ダイアログを表示する
Function bIsBookOpen(ByRef szBookName As String) As Boolean
  ' Contributed by Rob Bovey
  On Error Resume Next
  bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

早速参考リンク先にあるコードを使ってみようとしたところ、そのまま使えないことが発覚！

Windowsにしろ、Macにしろ、選択したファイル名を取得できるようにちょっと工夫してあげる必要があるようです。

まず、選択するファイルがxlsではなく、xlsxの場合には赤色マーカーの部分をWindows・Macの両方を修正する必要があります。

また、今回はあえてそれぞれのプロシージャー内で処理を完結させるつもりがないため、選択した情報を戻り値として取得するように変更します。

最後の一工夫

けれど、それでもまだ工夫が必要だということがわかりました。
Macの方でファイルを複数選択しても、サンプルコードでもファイルが開かれなかったのです。

デバッグで確認してみて検証した結果、どうやら原因は２つありました。

フルパスではなく、先頭のMacintosh HDが不要であること
: ではなく、/ にする。

最終コード：使っているOSによって処理を切り分ける

ということで、最終的なコードは下記のようになりました。
~~ただし、Windows版がまだ試せていませんので、来週確認できるので確認でき次第ご報告します。~~

（4/19追記）
Windows版でも確認できましたので、Windowsの箇所についてコードを修正しました。

メインVBA


Sub test2()
    Dim openWb As Workbook
    Dim openFileName As Variant, fileName As Variant

    ' Windows版かMac版かによって処理を分けて、ファイルを複数選択する
    openFileName = WINorMAC
    If Not Application.OperatingSystem Like "*Mac*" Then
        ' Windows
        If IsEmpty(openFileName) Then
            MsgBox "キャンセルされました"
            Exit Sub
        End If
    Else
        ' Mac
        If openFileName = "" Then
            MsgBox "キャンセルされました"
            Exit Sub
        Else
            ' 文字列をカンマで区分けして、配列に格納する
            openFileName = Split(openFileName, ",")
        End If
    End If
    
    
    ' 選択したファイルを開く
    For Each fileVar In openFileName
        If Application.OperatingSystem Like "*Mac*" Then
            fileVar = Replace(Replace(fileVar, ":", "/"), "Macintosh HD", "")
        End If
        
        Workbooks.Open fileVar
        Set openWb = ActiveWorkbook
        
         ' 処理を書く
        
        Application.DisplayAlerts = False
        openWb.Close
        Application.DisplayAlerts = True
    Next fileVar
End Sub

※青色マーカーの箇所の部分については、本来openFileName = Falseかと思いますが・・・
ファイルを選択しなかった場合は、Macの場合空欄（””）で値が返ってくるので、このように設定します。

（4/19追記）
ちなみに、Windowsの場合には、ファイルを選択しなかった場合はEmptyが返ってくるので、IsEmptyで判別するようにします。

最終コード（呼び出すコード）

VBA

' WindowsとMacで切り分けるプロシージャー
Function WINorMAC() As Variant
    Dim MyFiles As Variant
     ' Test for the operating system.
    If Not Application.OperatingSystem Like "*Mac*" Then
        ' Is Windows.
        MyFiles = Select_File_Or_Files_Windows
    Else
        ' Is a Mac and will test if running Excel 2011 or higher.
        If Val(Application.Version) > 14 Then
            MyFiles = Select_File_Or_Files_Mac
        End If
    End If
    
    ' 選択したファイルを戻り値に設定する
    WINorMAC = MyFiles
End Function
    


' Windowsでファイル選択ダイアログを表示する
Function Select_File_Or_Files_Windows()
    Dim SaveDriveDir As String
    Dim MyPath As String
    Dim Fname As Variant
    Dim N As Long
    Dim FnameInLoop As String
    Dim mybook As Workbook

    ' Save the current directory.
    SaveDriveDir = CurDir

    ' Set the path to the folder that you want to open.
    MyPath = Application.DefaultFilePath

    ' Change drive/directory to MyPath.
    ChDrive MyPath
    ChDir MyPath

    ' Open GetOpenFilename with the file filters.
    Fname = Application.GetOpenFilename( _
            FileFilter:="Excel File, *.xls*", _
            Title:="Select a file or files", _
            MultiSelect:=True)

    ' Change drive/directory back to SaveDriveDir.
    ChDrive SaveDriveDir
    ChDir SaveDriveDir

    ' 選択したファイルを戻り値に設定する
    Select_File_Or_Files_Windows = Fname
End Function



' Macでファイル選択ダイアログを表示する    
Function Select_File_Or_Files_Mac() As Variant
    Dim MyPath As String
    Dim MyScript As String
    Dim MyFiles As String
    Dim MySplit As Variant
    Dim N As Long
    Dim Fname As String
    Dim mybook As Workbook

    On Error Resume Next
    MyPath = MacScript("return (path to documents folder) as String")
    'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"

    ' In the following statement, change true to false in the line "multiple
    ' selections allowed true" if you do not want to be able to select more
    ' than one file. Additionally, if you want to filter for multiple files, change
    ' {""com.microsoft.Excel.xls""} to
    ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
    ' if you want to filter on xls and csv files, for example.
    MyScript = _
    "set applescript's text item delimiters to "","" " & vbNewLine & _
               "set theFiles to (choose file of type " & _
             " {""org.openxmlformats.spreadsheetml.sheet""} " & _
               "with prompt ""Please select a file or files"" default location alias """ & _
               MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
               "set applescript's text item delimiters to """" " & vbNewLine & _
               "return theFiles"

    MyFiles = MacScript(MyScript)
    On Error GoTo 0
        
    ' 選択したファイルを戻り値に設定する
    Select_File_Or_Files_Mac = MyFiles
End Function



' Windowsでファイル選択ダイアログを表示する
Function bIsBookOpen(ByRef szBookName As String) As Boolean
    ' Contributed by Rob Bovey
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

まとめ

いかがでしたでしょうか？

「Mac　VBA　ファイル　複数選択できない」とGoogleで検索しても、上位３ページにはそもそもMacに関する情報はほとんど表示されず。

しかも、表示されたページでは、Macで使用するGetOpenFilenameメソッドについてこのように書かれている記事ばかり。

「ワイルドカードの使用できない」
「ファイルの複数選択できない」

あと、だいたいMacのマクロは使えないという記事ばかり。
ぼくもずっとそう思っていました。

けれど、一番使いたかったGetOpenFilenameメソッドの活用だけでなく、日本語入力の位置ずれ問題も解消できたことで、ぼくが作成するほとんどのマクロはMacで事足りるようになりました(^^)v

同じような悩みを持っている方にとって、解決の助けになれば幸いです。

最後まで読んでいただき、ありがとうございました！

MEMO

Excel For Macでマクロを作成する上での問題解決
①日本語入力の位置ずれ問題→エディッターの設定でフォントを変更する
②ダイアログで複数ファイル選択不可→VBA コードと Apple Script を組み合わせて使用する

【特集】独学では開発言語の習得が難しいと感じている方向け

一つ目は、
侍エンジニア塾
です。

VBAやJavaScript関連でネット検索したことがある方であれば、一度は見かけたことある名前かと思います。
JavaやPython、C言語、VBA、JavaScriptなど、様々なプログラミング言語をオンラインで習得するためのサービスを提供しているところなので、自分が習得したい言語がもしありましたら、無料体験レッスンを受けてみると良いかもしれません。

そこでプロ講師に相談をして、習得するプログラミング言語に対して直接質問するのがベストです。