今回は指定したフォルダ内のサブフォルダを全て取得して、サブフォルダ内のファイルをすべて1つのファイルに読み込む方法をご説明します。
年や月、日別に分けられて管理されているデータを1つのファイルにまとめることで、集計が非常に楽になります。
別ファイルのシートのデータを転記するのではなく、シートをそのままコピーします。
読み込むことで、他のファイルを集計する際などに、別ファイルを操作するよりもVBAが書かれたファイルのみで操作が出来るため、処理のコードが簡素になります。
サブフォルダ内のファイルを読み込むには、直下のフォルダを指定して、それからサブフォルダを取得します。
順番に説明します。
その他の方法でファイルを読み込む方法は下記記事をご覧ください。
1.メインフォルダの指定方法
サブフォルダの取得方法については、直下のメインフォルダを指定してサブフォルダを取得するという処理となります。
ダイアログで指定する方法や、直接コードで指定する方法などフォルダの指定方法がいくつかありますので、順番に説明します。
コード内で直接フォルダを指定する
フォルダを指定するには「CreateObject(“WScript.Shell”)」で指定します。
本来カレントフォルダの指定は「ChDirプロパティ」を使用しますが、共有ネットワーク上のフォルダに対応できるように「CreateObject(“WScript.Shell”)」を使用しています。
Sub Sample1()
With CreateObject("WScript.Shell")
.CurrentDirectory = "C:\Sampleフォルダ\"
End With
End Subダイアログボックスで指定する
ダイアログボックスで取得する場合は「Application.FileDialog(msoFileDialogFolderPicker ).Showと書きます。
指定されたフォルダ名は「SelectedItems(1)」で取得します。
指定したフォルダが存在しないとエラーとなるため、「.Show <> 0 」で指定されたフォルダ名が存在するか判定して、存在する場合は取得します。
Sub Sample2()
Dim myFolder As Variant
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> 0 Then
myFolder = .SelectedItems(1)
End If
End With
MsgBox myFolder
End Sub2.指定フォルダ内のサブフォルダをすべて取得する
フォルダの指定ができましたので、次に指定したフォルダ内のサブフォルダを取得する方法です。
フォルダの一覧を取得出来てしまえば、各フォルダ内のファイルを開く事も可能です。
フォルダ内のサブフォルダを取得する方法は「FileSystemObject」を使用します。
FileSystemObjectの使い方
「FileSystemObject」はフォルダやファイルを操作する際に使用するオブジェクトです。
FileSystemObjectは参照設定をするか「CreateObject」で使用できるようにします。
他のPCでコードを使いまわしても問題ないように今回はCreateObjectを使用します。
Sub Sample3()
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
End Subサブフォルダを取得する
フォルダを取得するには「GetFolder」関数を使用します。
サブフォルダを取得するにはGetFolderで取得したフォルダ内「SubFolders」コレクションで取得できます。
GetFolderは指定されたフォルダーがない場合にエラーとなりますので、エラー処理が必要です。
次のコードはダイアログボックスで取得出来たフォルダ内のサブフォルダをすべて取得します。
「Sampleフォルダ」を指定して、その中のサブフォルダを取得したいと思います。
今回は次のような「Sampleフォルダ」内に「2016〜2019」のサブフォルダを用意しました。
Sub Sample4()
Dim myFolder As Variant
Dim Fso As Object
Dim GetFolder As Object
Dim Fol As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> 0 Then
myFolder = .SelectedItems(1)
End If
End With
With CreateObject("WScript.Shell")
.CurrentDirectory = myFolder
End With
Set GetFolder = Fso.GetFolder(myFolder)
For Each Fol In GetFolder.SubFolders
Debug.Print Fol.Name
Next
Set GetFolder = Nothing
End Subイミディエイトに2016〜2019のサブフォルダが取得できました。
3サブフォルダ内のファイルをすべて読み込む
サブフォルダを取得出来ましたので、次はサブフォルダ内のフィアルを全て読み込む方法です。
上記のサブフォルダの中にそれぞれの年度のファイルを用意しました。
(今回はファイルが1つですが、複数でも読み込みます。)
各ファイルには「1月～12月」と12個のシートがあります。
こちらの形式のファイルを4年分読み込みます。
もしシート名が同じである場合は、すでに同じシート名が存在する場合は2つ目以降のシートは自動的にナンバリングされますので、シート名を分岐条件にするなどの処理を組み込む以外は基本的にそのまま読み込んでも問題ありません。
Sub Sample5()
Dim myFolder As Variant
Dim Fso As Object
Dim GetFolder As Object
Dim Fol As Object
Dim Filename As String
Dim IsBookOpen As Boolean
Dim OpenBook As Workbook
Dim ShCount As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> 0 Then
myFolder = .SelectedItems(1)
End If
End With
With CreateObject("WScript.Shell")
.CurrentDirectory = myFolder
End With
Set GetFolder = Fso.GetFolder(myFolder)
For Each Fol In GetFolder.SubFolders 'サブフォルダをループ
With CreateObject("WScript.Shell")
.CurrentDirectory = Fol 'サブフォルダをカレントフォルダに指定
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
Next
Set GetFolder = Nothing
End Subすべて表示しきれませんが、4年分の48シートを読み込めました。
コードの説明
少し長いので、簡単にコードの説明です。
「Application.FileDialog(msoFileDialogFolderPicker)」でフォルダを指定するダイアログを表示します。
「myFolder = .SelectedItems(1)」で選択されたフォルダを取得しています。
「Set GetFolder = Fso.GetFolder(myFolder)」で取得したフォルダをObjectへ格納しています。
「For Each Fol In GetFolder.SubFolders」の「GetFolder.SubFolders」で格納したフォルダのサブフォルダをコレクションとしてループしています。
「.CurrentDirectory = Fol」でコレクションから取得したフォルダをカレントフォルダにして、フォルダ内のファイルをループで取得しています。
これですべてのサブフォルダ内のファイルを読み込むことができました。
