Excel VBA 指定フォルダ内のサブフォルダを全て取得してファイルを開く

今回は指定したフォルダ内のサブフォルダを全て取得する方法をご説明します。

また、取得した全てのサブフォルダ内のファイルを開く方法も併せてご説明します。

その他の方法でファイルを開く場合はこちらをご覧ください。

1.フォルダの指定方法
- コード内で直接フォルダを指定する
- ダイアログボックスで指定する
2.指定フォルダ内のサブフォルダをすべて取得する
- FileSystemObjectの使い方
- サブフォルダを取得する
3.サブフォルダ内のファイルをすべて開く

1.フォルダの指定方法

コードに直接フォルダを指定する方法と、ダイアログボックスを表示して、選択されたフォルダを取得する方法をご説明します。

フォルダの指定方法の詳細は「Excel VBA 指定したフォルダ内のファイルすべて開く」をご覧ください。

コード内で直接フォルダを指定する

フォルダを指定するには「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 Sub

2.指定フォルダ内のサブフォルダをすべて取得する

フォルダの指定ができましたので、次に指定したフォルダ内のサブフォルダを取得する方法です。

フォルダの一覧を取得出来てしまえば、各フォルダ内のファイルを開く事も可能です。

フォルダ内のサブフォルダを取得する方法は「FileSystemObject」を使用します。

FileSystemObjectの使い方

「FileSystemObject」はフォルダやファイルを操作する際に使用するオブジェクトです。

FileSystemObjectは参照設定をするか「CreateObject」で使用できるようにします。

他のPCでコードを使いまわしても問題ないように今回はCreateObjectを使用します。

Sub Sample3()

Dim Fso     As Object

Set Fso = CreateObject("Scripting.FileSystemObject")

End Sub

サブフォルダを取得する

フォルダを取得するには「GetFolder」関数を使用します。

GetFolderはフォルダーがない場合にエラーとなりますので、エラー処理が必要です。

次のコードはダイアログボックスで取得出来たフォルダ内のサブフォルダをすべて取得します。

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

3.サブフォルダ内のファイルをすべて開く

指定したフォルダのサブフォルダをすべて取得出来ましたので、最後にサブフォルダ内のファイルをすべて取得する方法です。

文頭でご紹介した「Excel VBA 指定したフォルダ内のファイルすべて開く」のSample2のコードを使用します。

注意点として、サブフォルダを取得する場合に、各サブフォルダに同じファイル名が存在する場合があります。

その場合は次のコードでは開く事ができないのでご注意ください。

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

Set Fso = CreateObject("Scripting.FileSystemObject")

With Application.FileDialog(msoFileDialogFolderPicker)

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

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
                          
            Workbooks.Open (Filename), UpdateLinks:=1
                                   
        End If
        
    End If
    
    Filename = Dir()
    
Loop

Next

Set GetFolder = Nothing

End Sub