Excel VBA 指定したフォルダ内のファイルをすべて読み込む

今回は指定したフォルダ内のファイルをすべて読み込む方法です。

別ファイルのシートのデータを転記するのではなく、シートをそのままコピーします。

他のファイルを集計する際などに、別ファイルを操作するよりもVBAが書かれたファイルのみで操作が出来るため、コードが簡素になります。

本記事のファイルを開く部分については「指定したフォルダ内のファイルすべて開く」をご覧ください。

その他のファイルを読み込む方法については、次の記事をご覧ください。

• 指定したファイルを読み込む
• ダイアログで指定したファイルを読み込む

1.ファイルを読み込む

開いたファイルを読み込むには、ファイルを開いた直後に次のように書きます。

シート名を指定するか、すべて指定して「Copy」メソッドでコピーします。

貼り付け先にVBAの書かれたBookを指定します。

読み込み位置の部分で貼り付け先を指定できます。

1つのシートを読み込む

Worksheets(シート名).Copy after:=ThisWorkbook.Worksheets(読み込み位置)
    
Workbooks(ファイル名).Close savechanges:=False

すべてのシートを読み込む

Worksheets.Copy after:=ThisWorkbook.Worksheets(読み込み位置)
    
Workbooks(ファイル名).Close savechanges:=False

2.フォルダを直接指定してファイルを読み込む

次のコードは指定されたフォルダ内のファイルを順番に開いて、開いた直後にVBAが書かれたファイルに読み込みます。

「.CurrentDirectory = “C:\Sample\”」の部分はサンプル用なので適宜変更してください。

Sub Sample1()

Dim Filename    As String
Dim IsBookOpen  As Boolean
Dim OpenBook    As Workbook
Dim ShCount     As Long

With CreateObject("WScript.Shell")
    
    .CurrentDirectory = "C:\Sample\"
    
End With

Filename = Dir("*.xlsx")
     
Do While Filename <> ""
    
    If Filename <> ThisWorkbook.Name Then
    
        IsBookOpen = False
        
        For Each OpenBook In Workbooks
                    
            If OpenBook.Name = Filename Then
            
                IsBookOpen = True
                
                Exit For
                
            End If
            
        Next
        
        If IsBookOpen = False Then        
            
            ShCount = ThisWorkbook.Worksheets.Count
                          
            Workbooks.Open (Filename), UpdateLinks:=1
            
            Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount)
    
            Workbooks(Filename).Close savechanges:=False
                                   
        End If
        
    End If
    
    Filename = Dir()
    
Loop

End Sub

コードの説明です。

「.CurrentDirectory = “C:\Sample\”」でカレントフォルダを指定しています。

本来カレントフォルダの指定は「ChDirプロパティ」を使用しますが、共有ネットワーク上のフォルダに対応できるように「CreateObject(“WScript.Shell”)」を使用しています。

「Dir」関数でファイル名を取得しながら、フォルダ内をループします。

「Workbooks.Open (Filename)」でファイルを開きます。

開いた直後に「Worksheets.Copy after:=ThisWorkbook.Worksheets」でシートをVBAの書かれたファイルにコピーしています。

「Workbooks(Filename).Close savechanges:=False」で開いたファイルを保存しないで閉じます。

3.ダイアログで指定したフォルダ内のファイルをすべて読み込む

ダイアログを開いてフォルダを指定して、指定されたフォルダ内のファイルをすべて読み込む方法です。

FileDialogの使い方

ダイアログボックスの表示は「FileDialog」を使用します。

ダイアログを表示するには「Application.FileDialog(処理方法).Show」と書きます。

フォルダの操作は「msoFileDialogFolderPicker」を使用します。

選択したフォルダパスを取得するには、「SelectedItemsプロパティ」を使用します。

SelectedItems(インデックス番号)で指定します。

また、今回はフォルダを1つしか選択しない想定で、「SelectedItems(1)」とします。

キャンセルや「×」などで閉じられた場合は、エラーとなりますので処理を組み込みます。

Showメソッドでキャンセルを押した際の戻り値が「0」なので、こちらで判定します。

「FoleDialog」の使い方は「指定したフォルダ内のファイルすべて開く」の「3.ダイアログでフォルダを指定する」をご覧ください。

Sub Sample2()

Dim myFolder As Variant

With Application.FileDialog(msoFileDialogFolderPicker)

    If .Show <> 0 Then
    
        myFolder = .SelectedItems(1)
    
    End If

End With

MsgBox myFolder

End Sub

取得したフォルダ内のファイルを読み込む

FileDialogでフォルダを指定出来たら、次はフォルダ内のファイルを全て開きます。

各ファイルを開いた直後に、Thisworkbookにファイルを読み込むコードを記載します。

基本的にファイルを開いて、読み込む部分は「Sample1」と同じです。

Sub Sample3()

Dim Filename    As String
Dim IsBookOpen  As Boolean
Dim OpenBook    As Workbook
Dim myFolder 　 As Variant
Dim ShCount     As Long

With Application.FileDialog(msoFileDialogFolderPicker)

    If .Show <> 0 Then
    
        myFolder = .SelectedItems(1)
    
    End If

End With

With CreateObject("WScript.Shell")
    
    .CurrentDirectory = myFolder
    
End With

Filename = Dir("*.xlsx")
     
Do While Filename <> ""
    
    If Filename <> ThisWorkbook.Name Then

    　　ShCount = ThisWorkbook.Worksheets.Count

        IsBookOpen = False
        
        For Each OpenBook In Workbooks
                    
            If OpenBook.Name = Filename Then
            
                IsBookOpen = True
                
                Exit For
                
            End If
            
        Next
        
        If IsBookOpen = False Then
                          
            Workbooks.Open (Filename), UpdateLinks:=1

            Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount)
    
            Workbooks(Filename).Close savechanges:=False                
        End If
        
    End If
    
    Filename = Dir()
    
Loop

End Sub