📝

【VBA】選択したフォルダ内の複数のエクセルファイルのワークブックオブジェクトを作って処理する

2023/07/04に公開

【VBA】ファイルパスからワークブックオブジェクトを作るでファイルパスからワークブックオブジェクトを作る→実際に処理するといったコードを紹介しました。
フォルダから複数のエクセルファイルを選択した場合は以下のようなコードになります。

【VBA】フォルダ内のキーワードを含むエクセルファイルリストを返すで使用したコードとの合わせ技になります。

Sub test()
    
    Dim fileDialog As fileDialog
    Dim folderPath As String
    
    ' FileDialogオブジェクトの初期化
    Set fileDialog = Application.fileDialog(msoFileDialogFolderPicker)
    
    With fileDialog
    
        ' ダイアログのタイトル設定
        .Title = "フォルダを選択してください"
        
        ' ファイル選択ダイアログの表示
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        End If
        
        If folderPath = "" Then
            MsgBox "フォルダを選択してください"
        End If
        
    End With
    
    Set fileDialog = Nothing
    
    '配列の宣言
    Dim fileList As Variant
    ReDim fileslist(1 To 1)
    
    '指定したフォルダ内のエクセルファイルリストを取得
    '第二引数はキーワード(今回は指定しないので""としている)
    fileList = GetMatchingExcelFiles(folderPath, "")
    
    Dim i As Long
    Dim wb As Workbook
    
    For i = LBound(fileList) To UBound(fileList)
        
        Set wb = Workbooks.Open(fileList(i))
        
        'A1セルの内容を表示
        MsgBox wb.Worksheets(1).Range("A1").Value
    
        '保存せずに閉じる
        wb.Close SaveChanges:=False
        
    Next i
    
End Sub


Function GetMatchingExcelFiles(folderPath As String, keyword As String) As Variant
    '選択したフォルダ内のキーワードを含むエクセルファイルリストを返す
    
    Dim filesArray() As Variant
    Dim fileName     As String
    Dim i            As Long
    Dim fileCount    As Long

    ' フォルダ内のすべてのファイルを取得(.xlsx)
    fileName = Dir(folderPath & "\*.xlsx")

    ' マッチするファイルを格納するための配列を初期化
    ReDim filesArray(1 To 1)
    fileCount = 0

    ' キーワードに一致するファイルを配列に追加(.xls)
    fileName = Dir(folderPath & "\*.xls")
    Do While fileName <> ""
        If InStr(1, fileName, keyword, vbTextCompare) > 0 Then
            fileCount = fileCount + 1
            ReDim Preserve filesArray(1 To fileCount)
            filesArray(fileCount) = folderPath & "\" & fileName
        End If
        fileName = Dir()
    Loop

    ' マッチするファイルが存在しない場合は、空の配列を返す
    If fileCount = 0 Then
        GetMatchingExcelFiles = filesArray()
    Else
        GetMatchingExcelFiles = filesArray
    End If

End Function

Sub()とFunction()に分かれているのでよく見てください。
Subではフォルダを選択させてフォルダパスをFunctionであるGetMatchingExcelFilesに渡しています。
GetMatchingExcelFilesは第二引数にキーワードを必要としているので、例えば「様式1」のみ必要な場合はfileList = GetMatchingExcelFiles(folderPath, "様式1")になります。
fileListにはファイルパスが配列として格納されているので、For文で1つずつ取り出して処理してあげます。
Dim wb As WorkbookはFor文の外でいいですが、Set wbはFor分の中に書きます。
このコードではフォルダ内のすべてのエクセルファイルのA1セルの内容を順番にメッセージボックスで表示します。
MsgBox wb.Worksheets(1).Range("A1").Valueのところをしたい処理に書き換えてお使いください。

Discussion