★ 指定したフォルダ内の、すべてのサブフォルダを延々と掘っていって、『すべてのファイルとすべてのサブフォルダ』の基本情報を指定したシートにゲットする（吸い込む）プログラム。（再帰的な処理）

　　
※2022/12/06 追記

★かなり重要な注意事項
後述の「Dir」を使う場合に関しては、
「Dir関数は認識できない文字（文字コード？）があるらしく、また、最悪なことに、プログラムの書き方によっては、”エラーが出てほしいところで出ない”」
という機能不足や不都合があるようです。
システムとしては致命的になってしまうので、基本的には「使わないほうが無難」なようです。

どうしても使いたいなら
『「確実にパソコン内」だけで付けたファイル名しか「絶対に・100％」ありえない』、
という前提の場合しか役に立たないようです。

また、Dir関数を使うほうが速度は４、５倍は速いようですが、一部のファイル名を認識できずにエラーになるようでは、全てのファイルやフォルダを拾えません。「４、５倍は速い」なんてものは何の意味もない、ということになります。

※2024/01/28追記
電帳法の関係でExcelで検索簿を作っていたら、Dir関数でのファイルの存在チェックで、「機種依存文字」が、Windows機種依存文字であるにもかかわらず、Dir関数では認識できずにエラーになる、ということがわかりました。
前述のことは、そのことを言っていたのですね・・・。勉強不足ですみません。
ですので、「全フォルダをループしてファイル名を調べて何かする、という場合は、もはやDir関数でのループは絶対に勧めてはいけない方法、ということになりました。
「絶対に機種依存文字は使いようがない」という状況の、ループ以外の場所でなら、使えます。
いずれにしましても、WebにはDir関数を使って再帰的にフォルダを掘っていくサンプルコードやQ&Aサイトでの回答がありますが、全部、真似しないようにご注意ください。FSOだけを使っているサンプルプログラムや回答だけを拾ってください。FSOは、VBEのウォッチウィンドウなどでは機種依存文字を「？」で表示していますが、実際には、ちゃんと機種依存文字を認識してくれます。

そのあたりについて詳しく書いてあるWebサイトをご紹介します。
mhtmlなどで保存しておくことをおすすめします。
VBAでファイルリストを高速に取得する関数を自作する part1
VBAでファイルリストを高速に取得する関数を自作する part2
VBAでファイルリストを高速に取得する関数を自作する part3
VBAでファイルリストを高速に取得する関数を自作する part4

↑「ファイル・フォルダリストをゲットするだけ」というシーンでしか使えないかもしれませんが、Dir関数を使うよりも何倍も速いプログラムコードも紹介されています。
もちろん、文字コードの問題もありません。
ほんと、mhtmlなどで保存しておくことをおすすめします。

　　
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
以下、本文です。
　　

以降に挙げたプログラムを標準モジュールに単純にALLコピペして、
「GetFolderAndFileListMain02」のほうだけを実行します。
（※バージョン2000の場合はエラーになります）

なお、このプログラムを、他のプログラムに流用したい場合は、
「GetFolderAndFileListMain02」のほうの
「o_ImpWs01.Cells.ClearContents」から「End With '↑列名（項目名）を書き込む」というところまでをカットし、
「GetFolderAndFileListSub」のほうの
２つのFor Each のループの中を、書き換えます。

ただその場合、「GetFolderAndFileListSub」のほうは、
基本、
１つ目のFor Each のループ（サブフォルダのみに対する処理）は、

For Each myFolder In FSO.GetFolder(s_folderPath).subfolders
　Call GetFolderAndFileListSub(o_ImpSheet, myFolder.Path, myCount)
Next myFolder

の３行だけがあればOKです。
下記のプログラムでは、事例として「サブフォルダの内容もゲットしたい」ということでやりましたので色々書いてありますが、
通常は、「ファイルたち」「だけ」に何かしたい場合が多いので、
その場合は、
２つ目のFor Each のループの内容だけ書き換えて（あるいは関数化して）、
１つ目のFor Each のループは、上記の３行だけがあればOKです。

'
'
Option Explicit
 
'####################################################
'すべてのファイルとフォルダの情報を調べたい、
'その「フォルダ」と、
'その情報を吸い込みたいシートを指定する処理。
'####################################################
 
Sub GetFolderAndFileListMain02()

 
    Dim o_AnswFDialg    As FileDialog
    Dim s_PickFldPath   As String
    Dim o_ImpWs01       As Worksheet
    

    '★ 設定部

'    s_FoldPath = "D:\1"    
     '↑ バージョン2000の場合は、「FileDialog」が無くてエラーに
     '　なるので、こちらのコードを使って、以降の「FileDialog」がらみの
     '　コードは全部コメントアウトする。
  
    Set o_AnswFDialg = Application. _
                        FileDialog(msoFileDialogFolderPicker)
    '↑ファイル選択ダイアログを使えるように準備。
    

'    Set o_ImpWs01 = Application. _
                      Workbooks.Item("ブック名"). _
'                      Worksheets.Item("シート名")
    Set o_ImpWs01 = ActiveWorkbook. _
                             ActiveSheet
    '↑ファイル情報を吸い込むシートを指定。
    
    
    
    '★ 実動部

    If Not o_AnswFDialg.Show Then
        Exit Sub
        '↑キャンセルされたときは終わる。
    Else
        s_PickFldPath = o_AnswFDialg.SelectedItems(1)
        '↑フォルダが選択されたら、
        '　ファイル選択ダイアログのオブジェクトの「SelectedItems プロパティ」にフォルダパスが自動的にゲットされるので、
        '　一時的な処理として、いったん適当な変数にそれをメモ代入。
    End If
    '↑ファイル選択ダイアログを実際に開き、
    '　フォルダが選択されたら（＝フォルダパスがゲットできたら）
    '　そのパスを一時保管して次へ行き、
    '　キャンセルされたらプログラムを終わる。


    o_ImpWs01.Cells.ClearContents
    '↑いったん、指定したシートをオールクリアして真っ白にする。
    
    
    With o_ImpWs01
        .Range("A1") = "パス"
        .Range("B1") = "容量（KB）"
        .Range("C1") = "種類"
        .Range("D1") = "作成日時"
        .Range("E1") = "アクセス日時"
        .Range("F1") = "更新日時"
    End With
    '↑列名（項目名）を書き込む
    
        

'    Call getFolderAndFileListSub(folderPath:=s_FoldPath)

    Call GetFolderAndFileListSub(o_ImpSheet:=o_ImpWs01, _
                                 s_folderPath:=s_PickFldPath)

    '↑リスト作成の実行。
    '　ピックアップされたフォルダバスの中を、
    '　すべてのサブフォルダのすべてのファイルを対象に、
    '　o_ImpWs01 に指定したシートにファイル情報を吸い込む（＝書き込む）。
    
    
    
End Sub



'####################################################
'実際にすべてのサブフォルダたちとファイルたちの、
'ファイルとフォルダの基本情報を、
'指定したシートに吸い込む処理。
'####################################################


 
Sub GetFolderAndFileListSub(o_ImpSheet As Worksheet, _
                            s_folderPath As String, _
                            Optional myCount As Long = 1)
 
 
   
'    Dim fso As New FileSystemObject        '←参照設定しないように作り変えたのでコメントアウト
    Dim FSO As Object
'    Dim o_FolderItem As Folder                 '←参照設定しないようにしたのでコメントアウトして次行のように書き換え
    Dim o_FolderItem As Object
'    Dim o_FileItem As File                     '←参照設定しないようにしたのでコメントアウトして次行のように書き換え
    Dim o_FileItem As Object
'    Dim Ws01 As Worksheet                  '←情報を吸い込むシートも引数化したのでコメントアウト


    '★ 設定部
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    '↑参照設定しなくてもFSO（FileSystemObject）を使えるようにする。

'    Set Ws01 = ActiveWorkbook.ActiveSheet '←情報を吸い込むシートも引数にしたのでコメントアウト
    
    On Error Resume Next
        
        
        
    '★ 実働部
        
    'サブフォルダを再帰的に覗いていって処理。
    For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders

        myCount = myCount + 1
        'ファイル情報を吸い込みたいシートの、
        'どの行に書き込みたいかを設定する


'        With Ws01
        With o_ImpSheet
            .Cells(myCount, 1) = o_FolderItem.Path & "\  (DIR)"         'サブフォルダのフルパスの書込み。「(DIR)」という目印あり。
'            .Cells(myCount, 1) = o_FolderItem.Path                      '同上。目印なし。
'            .Cells(myCount, 2) = Int(o_FolderItem.Size / 1024)          'サブフォルダのKBでの容量（整数。右クリックプロパティの「サイズ」の値に合わせない。）
            .Cells(myCount, 2) = Round(o_FolderItem.Size / 1024, 1)     'サブフォルダのKBでの容量（小数。右クリックプロパティの「サイズ」の値に合わせる。「詳細表示」のリスト表示の「サイズ」の値とは異なります。）
            .Cells(myCount, 3) = o_FolderItem.Type                      'オブジェクトの種類（フォルダ、××ファイル、など）
            .Cells(myCount, 4) = o_FolderItem.DateCreated               'サブフォルダの作成日
            .Cells(myCount, 5) = o_FolderItem.DateLastAccessed          'サブフォルダの最終アクセス日時
            .Cells(myCount, 6) = o_FolderItem.DateLastModified          'サブフォルダの最終更新日
        End With
        '↑ファイル情報を吸い込みたいシートに、具体内容を吸い込む。


        Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, myCount)
        '↑サブフォルダのサブフォルダを、（再帰的に）終わるまでどんどん掘っていく。
        '　サブフォルダが見つかるたびに、更に掘っていく。

    Next o_FolderItem
    '↑「サブフォルダのみを延々と深く最後まで掘っていくループ
    '　（この段階ではサブフォルダのフォルダ情報のみをゲット。
    '　　サブフォルダ内のファイルたちの情報は次の段階のForEachループでゲット。）
'

       

    '現在のフォルダの中「だけ」の、ファイル一覧の書き出し。（サブフォルダも含む）
    'コメント内容は前述の「サブフォルダ延々掘り」のときとおおむね同じ。（フォルダ情報がファイル情報になっただけ）
    For Each o_FileItem In FSO.GetFolder(s_folderPath).Files
    
        myCount = myCount + 1
        
'        With Ws01
        With o_ImpSheet
            .Cells(myCount, 1) = o_FileItem.Path                    'ファイルのフルパスを書き込む
'            .Cells(myCount, 2) = Int(o_FileItem.Size / 1024)        'ファイルの容量（整数。KB単位。プロパティの「サイズ」の値に合わせない。）
            .Cells(myCount, 2) = Round(o_FileItem.Size / 1024, 1)   'ファイルの容量（小数。KB単位。プロパティの「サイズ」の値に合わせる。「詳細表示」のリスト表示の「サイズ」の値とは異なります。）
            .Cells(myCount, 3) = o_FileItem.Type                    'ファイルの種類
            .Cells(myCount, 4) = o_FileItem.DateCreated             'ファイルの作成日
            .Cells(myCount, 5) = o_FileItem.DateLastAccessed        'ファイルの最終アクセス日
            .Cells(myCount, 6) = o_FileItem.DateLastModified        'ファイルの最終更新日
        End With
        
    Next o_FileItem
        

 
End Sub
'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

Option Explicit

'####################################################

'すべてのファイルとフォルダの情報を調べたい、

'その「フォルダ」と、

'その情報を吸い込みたいシートを指定する処理。

'####################################################

Sub GetFolderAndFileListMain02()

Dim o_AnswFDialg As FileDialog

Dim s_PickFldPath As String

Dim o_ImpWs01 As Worksheet

'★ 設定部

' s_FoldPath = "D:\1"

'↑ バージョン2000の場合は、「FileDialog」が無くてエラーに

'　なるので、こちらのコードを使って、以降の「FileDialog」がらみの

'　コードは全部コメントアウトする。

Set o_AnswFDialg = Application. _

FileDialog(msoFileDialogFolderPicker)

'↑ファイル選択ダイアログを使えるように準備。

' Set o_ImpWs01 = Application. _

Workbooks.Item("ブック名"). _

' Worksheets.Item("シート名")

Set o_ImpWs01 = ActiveWorkbook. _

ActiveSheet

'↑ファイル情報を吸い込むシートを指定。

'★ 実動部

If Not o_AnswFDialg.Show Then

Exit Sub

'↑キャンセルされたときは終わる。

Else

s_PickFldPath = o_AnswFDialg.SelectedItems(1)

'↑フォルダが選択されたら、

'　ファイル選択ダイアログのオブジェクトの「SelectedItems プロパティ」にフォルダパスが自動的にゲットされるので、

'　一時的な処理として、いったん適当な変数にそれをメモ代入。

End If

'↑ファイル選択ダイアログを実際に開き、

'　フォルダが選択されたら（＝フォルダパスがゲットできたら）

'　そのパスを一時保管して次へ行き、

'　キャンセルされたらプログラムを終わる。

o_ImpWs01.Cells.ClearContents

'↑いったん、指定したシートをオールクリアして真っ白にする。

With o_ImpWs01

.Range("A1") = "パス"

.Range("B1") = "容量（KB）"

.Range("C1") = "種類"

.Range("D1") = "作成日時"

.Range("E1") = "アクセス日時"

.Range("F1") = "更新日時"

End With

'↑列名（項目名）を書き込む

' Call getFolderAndFileListSub(folderPath:=s_FoldPath)

Call GetFolderAndFileListSub(o_ImpSheet:=o_ImpWs01, _

s_folderPath:=s_PickFldPath)

'↑リスト作成の実行。

'　ピックアップされたフォルダバスの中を、

'　すべてのサブフォルダのすべてのファイルを対象に、

'　o_ImpWs01 に指定したシートにファイル情報を吸い込む（＝書き込む）。

End Sub

'####################################################

'実際にすべてのサブフォルダたちとファイルたちの、

'ファイルとフォルダの基本情報を、

'指定したシートに吸い込む処理。

'####################################################

Sub GetFolderAndFileListSub(o_ImpSheet As Worksheet, _

s_folderPath As String, _

Optional myCount As Long = 1)

' Dim fso As New FileSystemObject '←参照設定しないように作り変えたのでコメントアウト

Dim FSO As Object

' Dim o_FolderItem As Folder '←参照設定しないようにしたのでコメントアウトして次行のように書き換え

Dim o_FolderItem As Object

' Dim o_FileItem As File '←参照設定しないようにしたのでコメントアウトして次行のように書き換え

Dim o_FileItem As Object

' Dim Ws01 As Worksheet '←情報を吸い込むシートも引数化したのでコメントアウト

'★ 設定部

Set FSO = CreateObject("Scripting.FileSystemObject")

'↑参照設定しなくてもFSO（FileSystemObject）を使えるようにする。

' Set Ws01 = ActiveWorkbook.ActiveSheet '←情報を吸い込むシートも引数にしたのでコメントアウト

On Error Resume Next

'★ 実働部

'サブフォルダを再帰的に覗いていって処理。

For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders

myCount = myCount + 1

'ファイル情報を吸い込みたいシートの、

'どの行に書き込みたいかを設定する

' With Ws01

With o_ImpSheet

.Cells(myCount, 1) = o_FolderItem.Path & "\ (DIR)" 'サブフォルダのフルパスの書込み。「(DIR)」という目印あり。

' .Cells(myCount, 1) = o_FolderItem.Path '同上。目印なし。

' .Cells(myCount, 2) = Int(o_FolderItem.Size / 1024) 'サブフォルダのKBでの容量（整数。右クリックプロパティの「サイズ」の値に合わせない。）

.Cells(myCount, 2) = Round(o_FolderItem.Size / 1024, 1) 'サブフォルダのKBでの容量（小数。右クリックプロパティの「サイズ」の値に合わせる。「詳細表示」のリスト表示の「サイズ」の値とは異なります。）

.Cells(myCount, 3) = o_FolderItem.Type 'オブジェクトの種類（フォルダ、××ファイル、など）

.Cells(myCount, 4) = o_FolderItem.DateCreated 'サブフォルダの作成日

.Cells(myCount, 5) = o_FolderItem.DateLastAccessed 'サブフォルダの最終アクセス日時

.Cells(myCount, 6) = o_FolderItem.DateLastModified 'サブフォルダの最終更新日

End With

'↑ファイル情報を吸い込みたいシートに、具体内容を吸い込む。

Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, myCount)

'↑サブフォルダのサブフォルダを、（再帰的に）終わるまでどんどん掘っていく。

'　サブフォルダが見つかるたびに、更に掘っていく。

Next o_FolderItem

'↑「サブフォルダのみを延々と深く最後まで掘っていくループ

'　（この段階ではサブフォルダのフォルダ情報のみをゲット。

'　　サブフォルダ内のファイルたちの情報は次の段階のForEachループでゲット。）

'現在のフォルダの中「だけ」の、ファイル一覧の書き出し。（サブフォルダも含む）

'コメント内容は前述の「サブフォルダ延々掘り」のときとおおむね同じ。（フォルダ情報がファイル情報になっただけ）

For Each o_FileItem In FSO.GetFolder(s_folderPath).Files

myCount = myCount + 1

' With Ws01

With o_ImpSheet

.Cells(myCount, 1) = o_FileItem.Path 'ファイルのフルパスを書き込む

' .Cells(myCount, 2) = Int(o_FileItem.Size / 1024) 'ファイルの容量（整数。KB単位。プロパティの「サイズ」の値に合わせない。）

.Cells(myCount, 2) = Round(o_FileItem.Size / 1024, 1) 'ファイルの容量（小数。KB単位。プロパティの「サイズ」の値に合わせる。「詳細表示」のリスト表示の「サイズ」の値とは異なります。）

.Cells(myCount, 3) = o_FileItem.Type 'ファイルの種類

.Cells(myCount, 4) = o_FileItem.DateCreated 'ファイルの作成日

.Cells(myCount, 5) = o_FileItem.DateLastAccessed 'ファイルの最終アクセス日

.Cells(myCount, 6) = o_FileItem.DateLastModified 'ファイルの最終更新日

End With

Next o_FileItem

End Sub

★上記のコードを、ファイルパスだけ（フォルダ無し。更新日等も無し。）をリストアップしたい場合。

２つめのプロシージャの「GetFolderAndFileListSub()」の
「For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders」のループの中身を、
「Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, myCount)」
の1行だけ残して、
「For Each o_FileItem In FSO.GetFolder(s_folderPath).Files」のループの
ファイル名を書き出すコードだけを残したもの・・・・、
です。

'
'
Option Explicit

'

 
'####################################################
'すべてのファイルとフォルダの情報を調べたい、
'その「フォルダ」と、
'その情報を吸い込みたいシートを指定する処理。
'####################################################
 
Sub GetFolderAndFileListMain02()

 
    Dim o_AnswFDialg    As FileDialog
    Dim s_PickFldPath   As String
    Dim o_ImpWs01       As Worksheet
    

    '★ 設定部

'    s_FoldPath = "D:\1"
     '↑ バージョン2000の場合は、「FileDialog」が無くてエラーに
     '　なるので、こちらのコードを使って、以降の「FileDialog」がらみの
     '　コードは全部コメントアウトする。
  
    Set o_AnswFDialg = Application. _
                        FileDialog(msoFileDialogFolderPicker)
    '↑ファイル選択ダイアログを使えるように準備。
    

'    Set o_ImpWs01 = Application. _
                      Workbooks.Item("ブック名"). _
'                      Worksheets.Item("シート名")
    Set o_ImpWs01 = ActiveWorkbook. _
                             ActiveSheet
    '↑ファイル情報を吸い込むシートを指定。
    
    
    
    '★ 実動部

    If Not o_AnswFDialg.Show Then
        Exit Sub
        '↑キャンセルされたときは終わる。
    Else
        s_PickFldPath = o_AnswFDialg.SelectedItems(1)
        '↑フォルダが選択されたら、
        '　ファイル選択ダイアログのオブジェクトの「SelectedItems プロパティ」にフォルダパスが自動的にゲットされるので、
        '　一時的な処理として、いったん適当な変数にそれをメモ代入。
    End If
    '↑ファイル選択ダイアログを実際に開き、
    '　フォルダが選択されたら（＝フォルダパスがゲットできたら）
    '　そのパスを一時保管して次へ行き、
    '　キャンセルされたらプログラムを終わる。


    o_ImpWs01.Cells.ClearContents
    '↑いったん、指定したシートをオールクリアして真っ白にする。
    
    
    With o_ImpWs01
        .Range("A1") = "パス"
'        .Range("B1") = "容量（KB）"
'        .Range("C1") = "種類"
'        .Range("D1") = "作成日時"
'        .Range("E1") = "アクセス日時"
'        .Range("F1") = "更新日時"
    End With
    '↑列名（項目名）を書き込む
    
        

'    Call getFolderAndFileListSub(folderPath:=s_FoldPath)

    Call GetFolderAndFileListSub(o_ImpSheet:=o_ImpWs01, _
                                 s_folderPath:=s_PickFldPath)

    '↑リスト作成の実行。
    '　ピックアップされたフォルダバスの中を、
    '　すべてのサブフォルダのすべてのファイルを対象に、
    '　o_ImpWs01 に指定したシートにファイル情報を吸い込む（＝書き込む）。
    
    
    
End Sub



'####################################################
'実際にすべてのサブフォルダたちとファイルたちの、
'ファイルとフォルダの基本情報を、
'指定したシートに吸い込む処理。
'####################################################


 
Sub GetFolderAndFileListSub(o_ImpSheet As Worksheet, _
                            s_folderPath As String, _
                            Optional myCount As Long = 1)
 
 
   
'    Dim fso As New FileSystemObject        '←参照設定しないように作り変えたのでコメントアウト
    Dim FSO As Object
'    Dim o_FolderItem As Folder                 '←参照設定しないようにしたのでコメントアウトして次行のように書き換え
    Dim o_FolderItem As Object
'    Dim o_FileItem As File                     '←参照設定しないようにしたのでコメントアウトして次行のように書き換え
    Dim o_FileItem As Object
'    Dim Ws01 As Worksheet                  '←情報を吸い込むシートも引数化したのでコメントアウト


    '★ 設定部
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    '↑参照設定しなくてもFSO（FileSystemObject）を使えるようにする。

'    Set Ws01 = ActiveWorkbook.ActiveSheet '←情報を吸い込むシートも引数にしたのでコメントアウト
    
    On Error Resume Next
        
        
        
    '★ 実働部
        
    'サブフォルダを再帰的に覗いていって処理。
    For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders

'        myCount = myCount + 1    '★★ ←これをコメントアウトすると、ファイルだけリストアップしたい時に良い。フォルダの分の空白行が無くなるので。
'        'ファイル情報を吸い込みたいシートの、
'        'どの行に書き込みたいかを設定する
'
'
''        With Ws01
'        With o_ImpSheet
'            .Cells(myCount, 1) = o_FolderItem.Path & "\  (DIR)"         'サブフォルダのフルパスの書込み。「(DIR)」という目印あり。
''            .Cells(myCount, 1) = o_FolderItem.Path                      '同上。目印なし。
''            .Cells(myCount, 2) = Int(o_FolderItem.Size / 1024)          'サブフォルダのKBでの容量（整数。右クリックプロパティの「サイズ」の値に合わせない。）
'            .Cells(myCount, 2) = Round(o_FolderItem.Size / 1024, 1)     'サブフォルダのKBでの容量（小数。右クリックプロパティの「サイズ」の値に合わせる。「詳細表示」のリスト表示の「サイズ」の値とは異なります。）
'            .Cells(myCount, 3) = o_FolderItem.Type                      'オブジェクトの種類（フォルダ、××ファイル、など）
'            .Cells(myCount, 4) = o_FolderItem.DateCreated               'サブフォルダの作成日
'            .Cells(myCount, 5) = o_FolderItem.DateLastAccessed          'サブフォルダの最終アクセス日時
'            .Cells(myCount, 6) = o_FolderItem.DateLastModified          'サブフォルダの最終更新日
'        End With
'        '↑ファイル情報を吸い込みたいシートに、具体内容を吸い込む。


        Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, myCount)
        '↑サブフォルダのサブフォルダを、（再帰的に）終わるまでどんどん掘っていく。
        '　サブフォルダが見つかるたびに、更に掘っていく。

    Next o_FolderItem
    '↑「サブフォルダのみを延々と深く最後まで掘っていくループ
    '　（この段階ではサブフォルダのフォルダ情報のみをゲット。
    '　　サブフォルダ内のファイルたちの情報は次の段階のForEachループでゲット。）
'

       

    '現在のフォルダの中「だけ」の、ファイル一覧の書き出し。（サブフォルダも含む）
    'コメント内容は前述の「サブフォルダ延々掘り」のときとおおむね同じ。（フォルダ情報がファイル情報になっただけ）
    For Each o_FileItem In FSO.GetFolder(s_folderPath).Files
    
        myCount = myCount + 1
        
'        With Ws01
        With o_ImpSheet
            .Cells(myCount, 1) = o_FileItem.Path                    'ファイルのフルパスを書き込む
'            .Cells(myCount, 2) = Int(o_FileItem.Size / 1024)        'ファイルの容量（整数。KB単位。プロパティの「サイズ」の値に合わせない。）
'            .Cells(myCount, 2) = Round(o_FileItem.Size / 1024, 1)   'ファイルの容量（小数。KB単位。プロパティの「サイズ」の値に合わせる。「詳細表示」のリスト表示の「サイズ」の値とは異なります。）
'            .Cells(myCount, 3) = o_FileItem.Type                    'ファイルの種類
'            .Cells(myCount, 4) = o_FileItem.DateCreated             'ファイルの作成日
'            .Cells(myCount, 5) = o_FileItem.DateLastAccessed        'ファイルの最終アクセス日
'            .Cells(myCount, 6) = o_FileItem.DateLastModified        'ファイルの最終更新日
        End With
        
    Next o_FileItem
        

 
End Sub
'
'


'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

Option Explicit

'####################################################

'すべてのファイルとフォルダの情報を調べたい、

'その「フォルダ」と、

'その情報を吸い込みたいシートを指定する処理。

'####################################################

Sub GetFolderAndFileListMain02()

Dim o_AnswFDialg As FileDialog

Dim s_PickFldPath As String

Dim o_ImpWs01 As Worksheet

'★ 設定部

' s_FoldPath = "D:\1"

'↑ バージョン2000の場合は、「FileDialog」が無くてエラーに

'　なるので、こちらのコードを使って、以降の「FileDialog」がらみの

'　コードは全部コメントアウトする。

Set o_AnswFDialg = Application. _

FileDialog(msoFileDialogFolderPicker)

'↑ファイル選択ダイアログを使えるように準備。

' Set o_ImpWs01 = Application. _

Workbooks.Item("ブック名"). _

' Worksheets.Item("シート名")

Set o_ImpWs01 = ActiveWorkbook. _

ActiveSheet

'↑ファイル情報を吸い込むシートを指定。

'★ 実動部

If Not o_AnswFDialg.Show Then

Exit Sub

'↑キャンセルされたときは終わる。

Else

s_PickFldPath = o_AnswFDialg.SelectedItems(1)

'↑フォルダが選択されたら、

'　ファイル選択ダイアログのオブジェクトの「SelectedItems プロパティ」にフォルダパスが自動的にゲットされるので、

'　一時的な処理として、いったん適当な変数にそれをメモ代入。

End If

'↑ファイル選択ダイアログを実際に開き、

'　フォルダが選択されたら（＝フォルダパスがゲットできたら）

'　そのパスを一時保管して次へ行き、

'　キャンセルされたらプログラムを終わる。

o_ImpWs01.Cells.ClearContents

'↑いったん、指定したシートをオールクリアして真っ白にする。

With o_ImpWs01

.Range("A1") = "パス"

' .Range("B1") = "容量（KB）"

' .Range("C1") = "種類"

' .Range("D1") = "作成日時"

' .Range("E1") = "アクセス日時"

' .Range("F1") = "更新日時"

End With

'↑列名（項目名）を書き込む

' Call getFolderAndFileListSub(folderPath:=s_FoldPath)

Call GetFolderAndFileListSub(o_ImpSheet:=o_ImpWs01, _

s_folderPath:=s_PickFldPath)

'↑リスト作成の実行。

'　ピックアップされたフォルダバスの中を、

'　すべてのサブフォルダのすべてのファイルを対象に、

'　o_ImpWs01 に指定したシートにファイル情報を吸い込む（＝書き込む）。

End Sub

'####################################################

'実際にすべてのサブフォルダたちとファイルたちの、

'ファイルとフォルダの基本情報を、

'指定したシートに吸い込む処理。

'####################################################

Sub GetFolderAndFileListSub(o_ImpSheet As Worksheet, _

s_folderPath As String, _

Optional myCount As Long = 1)

' Dim fso As New FileSystemObject '←参照設定しないように作り変えたのでコメントアウト

Dim FSO As Object

' Dim o_FolderItem As Folder '←参照設定しないようにしたのでコメントアウトして次行のように書き換え

Dim o_FolderItem As Object

' Dim o_FileItem As File '←参照設定しないようにしたのでコメントアウトして次行のように書き換え

Dim o_FileItem As Object

' Dim Ws01 As Worksheet '←情報を吸い込むシートも引数化したのでコメントアウト

'★ 設定部

Set FSO = CreateObject("Scripting.FileSystemObject")

'↑参照設定しなくてもFSO（FileSystemObject）を使えるようにする。

' Set Ws01 = ActiveWorkbook.ActiveSheet '←情報を吸い込むシートも引数にしたのでコメントアウト

On Error Resume Next

'★ 実働部

'サブフォルダを再帰的に覗いていって処理。

For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders

' myCount = myCount + 1 '★★ ←これをコメントアウトすると、ファイルだけリストアップしたい時に良い。フォルダの分の空白行が無くなるので。

' 'ファイル情報を吸い込みたいシートの、

' 'どの行に書き込みたいかを設定する

'' With Ws01

' With o_ImpSheet

' .Cells(myCount, 1) = o_FolderItem.Path & "\ (DIR)" 'サブフォルダのフルパスの書込み。「(DIR)」という目印あり。

'' .Cells(myCount, 1) = o_FolderItem.Path '同上。目印なし。

'' .Cells(myCount, 2) = Int(o_FolderItem.Size / 1024) 'サブフォルダのKBでの容量（整数。右クリックプロパティの「サイズ」の値に合わせない。）

' .Cells(myCount, 2) = Round(o_FolderItem.Size / 1024, 1) 'サブフォルダのKBでの容量（小数。右クリックプロパティの「サイズ」の値に合わせる。「詳細表示」のリスト表示の「サイズ」の値とは異なります。）

' .Cells(myCount, 3) = o_FolderItem.Type 'オブジェクトの種類（フォルダ、××ファイル、など）

' .Cells(myCount, 4) = o_FolderItem.DateCreated 'サブフォルダの作成日

' .Cells(myCount, 5) = o_FolderItem.DateLastAccessed 'サブフォルダの最終アクセス日時

' .Cells(myCount, 6) = o_FolderItem.DateLastModified 'サブフォルダの最終更新日

' End With

' '↑ファイル情報を吸い込みたいシートに、具体内容を吸い込む。

Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, myCount)

'↑サブフォルダのサブフォルダを、（再帰的に）終わるまでどんどん掘っていく。

'　サブフォルダが見つかるたびに、更に掘っていく。

Next o_FolderItem

'↑「サブフォルダのみを延々と深く最後まで掘っていくループ

'　（この段階ではサブフォルダのフォルダ情報のみをゲット。

'　　サブフォルダ内のファイルたちの情報は次の段階のForEachループでゲット。）

'現在のフォルダの中「だけ」の、ファイル一覧の書き出し。（サブフォルダも含む）

'コメント内容は前述の「サブフォルダ延々掘り」のときとおおむね同じ。（フォルダ情報がファイル情報になっただけ）

For Each o_FileItem In FSO.GetFolder(s_folderPath).Files

myCount = myCount + 1

' With Ws01

With o_ImpSheet

.Cells(myCount, 1) = o_FileItem.Path 'ファイルのフルパスを書き込む

' .Cells(myCount, 2) = Int(o_FileItem.Size / 1024) 'ファイルの容量（整数。KB単位。プロパティの「サイズ」の値に合わせない。）

' .Cells(myCount, 2) = Round(o_FileItem.Size / 1024, 1) 'ファイルの容量（小数。KB単位。プロパティの「サイズ」の値に合わせる。「詳細表示」のリスト表示の「サイズ」の値とは異なります。）

' .Cells(myCount, 3) = o_FileItem.Type 'ファイルの種類

' .Cells(myCount, 4) = o_FileItem.DateCreated 'ファイルの作成日

' .Cells(myCount, 5) = o_FileItem.DateLastAccessed 'ファイルの最終アクセス日

' .Cells(myCount, 6) = o_FileItem.DateLastModified 'ファイルの最終更新日

End With

Next o_FileItem

End Sub

★ 【ひな型化】～サブフォルダーを掘っていくループにさせたいことと、現在のフォルダのループにさせたいことを、さらに、関数化・分離した場合のテスト（引数の、他のプロシージャへの参照渡しでのさらなる引継ぎも含め）

以下のように、分割すれば、「サブフォルダを延々と掘って処理していくプログラム」がある程度「ひな型化」できるかも？
（※↓一応動きますがチェックが甘いのでちゃんと使えるかわかりません。あくまでもテストです。↓）

'
'
Option Explicit
 
'####################################################
'すべてのファイルとフォルダの情報を調べたい、
'その「フォルダ」と、
'その情報を吸い込みたいシートを指定する処理。
'####################################################
 
Sub GetFolderAndFileListMain02()
 
 
    Dim o_AnswFDialg    As FileDialog
    Dim s_PickFldPath   As String
    Dim o_ImpWs01       As Worksheet
    
 
    '★ 設定部
 
'    s_FoldPath = "D:\1"
     '↑ バージョン2000の場合は、「FileDialog」が無くてエラーに
     '　なるので、こちらのコードを使って、以降の「FileDialog」がらみの
     '　コードは全部コメントアウトする。

    Set o_AnswFDialg = Application. _
                        FileDialog(msoFileDialogFolderPicker)
    '↑ファイル選択ダイアログを使えるように準備。
    
 
'    Set o_ImpWs01 = Application. _
                      Workbooks.Item("ブック名"). _
'                      Worksheets.Item("シート名")

    Set o_ImpWs01 = ActiveWorkbook. _
                             ActiveSheet
    '↑ファイル情報を吸い込むシートを指定。
    
    
    
    '★ 実動部
 
    If Not o_AnswFDialg.Show Then
        Exit Sub
        '↑キャンセルされたときは終わる。
    Else
        s_PickFldPath = o_AnswFDialg.SelectedItems(1)
        '↑フォルダが選択されたら、
        '　ファイル選択ダイアログのオブジェクトの「SelectedItems プロパティ」にフォルダパスが自動的にゲットされるので、
        '　一時的な処理として、いったん適当な変数にそれをメモ代入。
    End If
    '↑ファイル選択ダイアログを実際に開き、
    '　フォルダが選択されたら（＝フォルダパスがゲットできたら）
    '　そのパスを一時保管して次へ行き、
    '　キャンセルされたらプログラムを終わる。
 

     '◆◆◆↓アクティブシートに何もしないなら以下のブロックは消して良い。
    o_ImpWs01.Cells.ClearContents
    '↑いったん、指定したシートをオールクリアして真っ白にする。
    
    '◆◆◆↓アクティブシートに何もしないなら以下のブロックは消して良い。
    With o_ImpWs01
        .Range("A1") = "パス"
        .Range("B1") = "容量（KB）"
        .Range("C1") = "種類"
        .Range("D1") = "作成日時"
        .Range("E1") = "アクセス日時"
        .Range("F1") = "更新日時"
    End With
    '↑列名（項目名）を書き込む
    
        
 
'    Call getFolderAndFileListSub(folderPath:=s_FoldPath)
 
    Call GetFolderAndFileListSub(o_ImpSheet:=o_ImpWs01, _
                                 s_folderPath:=s_PickFldPath)
 
    '↑リスト作成の実行。
    '　ピックアップされたフォルダバスの中を、
    '　すべてのサブフォルダのすべてのファイルを対象に、
    '　o_ImpWs01 に指定したシートにファイル情報を吸い込む（＝書き込む）。
    
    
    
End Sub
 
 
 
'####################################################
'実際にすべてのサブフォルダたちとファイルたちの、
'ファイルとフォルダの基本情報を、
'指定したシートに吸い込む処理。
'####################################################
 
 
 
Sub GetFolderAndFileListSub(o_ImpSheet As Worksheet, _
                            s_folderPath As String, _
                            Optional myCount As Long = 1)
 
 
   
'    Dim fso As New FileSystemObject        '←参照設定しないように作り変えたのでコメントアウト
    Dim FSO As Object
'    Dim o_FolderItem As Folder                 '←参照設定しないようにしたのでコメントアウトして次行のように書き換え
    Dim o_FolderItem As Object
'    Dim o_FileItem As File                     '←参照設定しないようにしたのでコメントアウトして次行のように書き換え
    Dim o_FileItem As Object
'    Dim Ws01 As Worksheet                  '←情報を吸い込むシートも引数化したのでコメントアウト
 
 
    '★ 設定部
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    '↑参照設定しなくてもFSO（FileSystemObject）を使えるようにする。
 
'    Set Ws01 = ActiveWorkbook.ActiveSheet '←情報を吸い込むシートも引数にしたのでコメントアウト
    
    On Error Resume Next
        
        
        
    '★ 実働部
        
    'サブフォルダを再帰的に覗いていって処理。
    For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders
 
        myCount = myCount + 1
        'ファイル情報を吸い込みたいシートの、
        'どの行に書き込みたいかを設定する

        '◆◆◆↓ サブフォルダに何もしなくても、
        '◆◆◆↓ 消すと再帰処理で深く掘っていくことができなくなるので消したらいけない。
        Call SubFolderWork01(o_ImpSheet, s_folderPath, myCount, o_FolderItem)
 
    Next o_FolderItem
    '↑「サブフォルダのみを延々と深く最後まで掘っていくループ
    '　（この段階ではサブフォルダのフォルダ情報のみをゲット。
    '　　サブフォルダ内のファイルたちの情報は次の段階のForEachループでゲット。）
'
 
       
 
    '現在のフォルダの中「だけ」の、すべてのファイルの
    '一覧の書き出し。（サブフォルダも含む）
    'コメント内容は前述の「サブフォルダ延々掘り」のときと
    'おおむね同じ。（フォルダ情報がファイル情報になっただけ）
    '　↓　 ↓
    For Each o_FileItem In FSO.GetFolder(s_folderPath).Files
    
        myCount = myCount + 1

    '◆◆◆↓ カレントフォルダの全ファイルに対して行う処理。
    '◆◆◆↓ カレントフォルダに何もしないなら以下のブロックは
    '◆◆◆↓ 消しても良い。
        Call CurrentFolderWork01(o_ImpSheet, s_folderPath, myCount, o_FileItem)
        
    Next o_FileItem
        
 
 
End Sub



'####################################################
'サブフォルダを掘るループにさせたい内容
'通常は、特にさせることはない。
'が、今回はサブフォルダの情報を知りたいので、以下のようなプログラムを書くことになる。
'引数は、TPO・目的によって、増やしたり減らしたり無くしたりする。
'また、参照渡しで、呼び出しモトの引数をそのまま引き継いでいます。
'◆◆◆ここのプロシージャはサブフォルダに対して何かするための
'◆◆◆プロシージャなので、サブフォルダに対して何もしないなら以下の
'◆◆◆コードは、FunctionやEnd Function 丸ごとを、
'◆◆◆すべてコメントアウトしても良い。
'####################################################

Function SubFolderWork01(o_ImpSheet As Worksheet, _
                         s_folderPath As String, _
                         myCount As Long, _
                         o_FolderItem As Object)

'◆◆◆ここのプロシージャはサブフォルダに対して何かするための
'◆◆◆プロシージャなので、サブフォルダに対して何もしないなら以下の
'◆◆◆コードは、FunctionやEnd Function 丸ごとを、
'◆◆◆すべてコメントアウトしても良い。

'オブジェクト変数「o_FolderItem」は、FSOを呼び出しモトでインスタンス化してしまっているので、
'この段階では固有型の「Folder」にはできず、総称型の「Object」にしかできない。

 
'        With Ws01
        With o_ImpSheet
            .Cells(myCount, 1) = o_FolderItem.Path & "\  (DIR)"         'サブフォルダのフルパスの書込み。「(DIR)」という目印あり。
'            .Cells(myCount, 1) = o_FolderItem.Path                      '同上。目印なし。
'            .Cells(myCount, 2) = Int(o_FolderItem.Size / 1024)          'サブフォルダのKBでの容量（整数。右クリックプロパティの「サイズ」の値に合わせない。）
            .Cells(myCount, 2) = Round(o_FolderItem.Size / 1024, 1)     'サブフォルダのKBでの容量（小数。右クリックプロパティの「サイズ」の値に合わせる。「詳細表示」のリスト表示の「サイズ」の値とは異なります。）
            .Cells(myCount, 3) = o_FolderItem.Type                      'オブジェクトの種類（フォルダ、××ファイル、など）
            .Cells(myCount, 4) = o_FolderItem.DateCreated               'サブフォルダの作成日
            .Cells(myCount, 5) = o_FolderItem.DateLastAccessed          'サブフォルダの最終アクセス日時
            .Cells(myCount, 6) = o_FolderItem.DateLastModified          'サブフォルダの最終更新日
        End With
        '↑ファイル情報を吸い込みたいシートに、具体内容を吸い込む。
 
 
        Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, myCount)
        '↑サブフォルダのサブフォルダを、（再帰的に）終わるまでどんどん掘っていく。
        '　サブフォルダが見つかるたびに、更に掘っていく。
        
End Function



'####################################################
'現在のフォルダの中でのループに、させたい内容
'通常は、こっちがメイン。
'    '◆◆◆ つまり、コメントアウトしちゃダメ！
'    '◆◆◆ ただし、アクティブシートに何もしない場合は
'    '◆◆◆ 該当するコードは消すか修正する。
'引数は、TPO・目的によって、増やしたり減らしたり無くしたりする。
'また、参照渡しで、呼び出しモトの引数をそのまま引き継いでいます。
'####################################################

Function CurrentFolderWork01(o_ImpSheet As Worksheet, _
                         s_folderPath As String, _
                         myCount As Long, _
                         o_FileItem As Object)



'オブジェクト変数「o_FileItem」は、FSOを呼び出しモトでインスタンス化してしまっているので、
'この段階では固有型の「File」にはできず、総称型の「Object」にしかできない。

 
'        With Ws01
        With o_ImpSheet
            .Cells(myCount, 1) = o_FileItem.Path                    'ファイルのフルパスを書き込む
'            .Cells(myCount, 2) = Int(o_FileItem.Size / 1024)        'ファイルの容量（整数。KB単位。プロパティの「サイズ」の値に合わせない。）
            .Cells(myCount, 2) = Round(o_FileItem.Size / 1024, 1)   'ファイルの容量（小数。KB単位。プロパティの「サイズ」の値に合わせる。「詳細表示」のリスト表示の「サイズ」の値とは異なります。）
            .Cells(myCount, 3) = o_FileItem.Type                    'ファイルの種類
            .Cells(myCount, 4) = o_FileItem.DateCreated             'ファイルの作成日
            .Cells(myCount, 5) = o_FileItem.DateLastAccessed        'ファイルの最終アクセス日
            .Cells(myCount, 6) = o_FileItem.DateLastModified        'ファイルの最終更新日
        End With
        
End Function

'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

Option Explicit

'####################################################

'すべてのファイルとフォルダの情報を調べたい、

'その「フォルダ」と、

'その情報を吸い込みたいシートを指定する処理。

'####################################################

Sub GetFolderAndFileListMain02()

Dim o_AnswFDialg As FileDialog

Dim s_PickFldPath As String

Dim o_ImpWs01 As Worksheet

'★ 設定部

' s_FoldPath = "D:\1"

'↑ バージョン2000の場合は、「FileDialog」が無くてエラーに

'　なるので、こちらのコードを使って、以降の「FileDialog」がらみの

'　コードは全部コメントアウトする。

Set o_AnswFDialg = Application. _

FileDialog(msoFileDialogFolderPicker)

'↑ファイル選択ダイアログを使えるように準備。

' Set o_ImpWs01 = Application. _

Workbooks.Item("ブック名"). _

' Worksheets.Item("シート名")

Set o_ImpWs01 = ActiveWorkbook. _

ActiveSheet

'↑ファイル情報を吸い込むシートを指定。

'★ 実動部

If Not o_AnswFDialg.Show Then

Exit Sub

'↑キャンセルされたときは終わる。

Else

s_PickFldPath = o_AnswFDialg.SelectedItems(1)

'↑フォルダが選択されたら、

'　ファイル選択ダイアログのオブジェクトの「SelectedItems プロパティ」にフォルダパスが自動的にゲットされるので、

'　一時的な処理として、いったん適当な変数にそれをメモ代入。

End If

'↑ファイル選択ダイアログを実際に開き、

'　フォルダが選択されたら（＝フォルダパスがゲットできたら）

'　そのパスを一時保管して次へ行き、

'　キャンセルされたらプログラムを終わる。

'◆◆◆↓アクティブシートに何もしないなら以下のブロックは消して良い。

o_ImpWs01.Cells.ClearContents

'↑いったん、指定したシートをオールクリアして真っ白にする。

'◆◆◆↓アクティブシートに何もしないなら以下のブロックは消して良い。

With o_ImpWs01

.Range("A1") = "パス"

.Range("B1") = "容量（KB）"

.Range("C1") = "種類"

.Range("D1") = "作成日時"

.Range("E1") = "アクセス日時"

.Range("F1") = "更新日時"

End With

'↑列名（項目名）を書き込む

' Call getFolderAndFileListSub(folderPath:=s_FoldPath)

Call GetFolderAndFileListSub(o_ImpSheet:=o_ImpWs01, _

s_folderPath:=s_PickFldPath)

'↑リスト作成の実行。

'　ピックアップされたフォルダバスの中を、

'　すべてのサブフォルダのすべてのファイルを対象に、

'　o_ImpWs01 に指定したシートにファイル情報を吸い込む（＝書き込む）。

End Sub

'####################################################

'実際にすべてのサブフォルダたちとファイルたちの、

'ファイルとフォルダの基本情報を、

'指定したシートに吸い込む処理。

'####################################################

Sub GetFolderAndFileListSub(o_ImpSheet As Worksheet, _

s_folderPath As String, _

Optional myCount As Long = 1)

' Dim fso As New FileSystemObject '←参照設定しないように作り変えたのでコメントアウト

Dim FSO As Object

' Dim o_FolderItem As Folder '←参照設定しないようにしたのでコメントアウトして次行のように書き換え

Dim o_FolderItem As Object

' Dim o_FileItem As File '←参照設定しないようにしたのでコメントアウトして次行のように書き換え

Dim o_FileItem As Object

' Dim Ws01 As Worksheet '←情報を吸い込むシートも引数化したのでコメントアウト

'★ 設定部

Set FSO = CreateObject("Scripting.FileSystemObject")

'↑参照設定しなくてもFSO（FileSystemObject）を使えるようにする。

' Set Ws01 = ActiveWorkbook.ActiveSheet '←情報を吸い込むシートも引数にしたのでコメントアウト

On Error Resume Next

'★ 実働部

'サブフォルダを再帰的に覗いていって処理。

For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders

myCount = myCount + 1

'ファイル情報を吸い込みたいシートの、

'どの行に書き込みたいかを設定する

'◆◆◆↓ サブフォルダに何もしなくても、

'◆◆◆↓ 消すと再帰処理で深く掘っていくことができなくなるので消したらいけない。

Call SubFolderWork01(o_ImpSheet, s_folderPath, myCount, o_FolderItem)

Next o_FolderItem

'↑「サブフォルダのみを延々と深く最後まで掘っていくループ

'　（この段階ではサブフォルダのフォルダ情報のみをゲット。

'　　サブフォルダ内のファイルたちの情報は次の段階のForEachループでゲット。）

'現在のフォルダの中「だけ」の、すべてのファイルの

'一覧の書き出し。（サブフォルダも含む）

'コメント内容は前述の「サブフォルダ延々掘り」のときと

'おおむね同じ。（フォルダ情報がファイル情報になっただけ）

'　↓　 ↓

For Each o_FileItem In FSO.GetFolder(s_folderPath).Files

myCount = myCount + 1

'◆◆◆↓ カレントフォルダの全ファイルに対して行う処理。

'◆◆◆↓ カレントフォルダに何もしないなら以下のブロックは

'◆◆◆↓ 消しても良い。

Call CurrentFolderWork01(o_ImpSheet, s_folderPath, myCount, o_FileItem)

Next o_FileItem

End Sub

'####################################################

'サブフォルダを掘るループにさせたい内容

'通常は、特にさせることはない。

'が、今回はサブフォルダの情報を知りたいので、以下のようなプログラムを書くことになる。

'引数は、TPO・目的によって、増やしたり減らしたり無くしたりする。

'また、参照渡しで、呼び出しモトの引数をそのまま引き継いでいます。

'◆◆◆ここのプロシージャはサブフォルダに対して何かするための

'◆◆◆プロシージャなので、サブフォルダに対して何もしないなら以下の

'◆◆◆コードは、FunctionやEnd Function 丸ごとを、

'◆◆◆すべてコメントアウトしても良い。

'####################################################

Function SubFolderWork01(o_ImpSheet As Worksheet, _

s_folderPath As String, _

myCount As Long, _

o_FolderItem As Object)

'◆◆◆ここのプロシージャはサブフォルダに対して何かするための

'◆◆◆プロシージャなので、サブフォルダに対して何もしないなら以下の

'◆◆◆コードは、FunctionやEnd Function 丸ごとを、

'◆◆◆すべてコメントアウトしても良い。

'オブジェクト変数「o_FolderItem」は、FSOを呼び出しモトでインスタンス化してしまっているので、

'この段階では固有型の「Folder」にはできず、総称型の「Object」にしかできない。

' With Ws01

With o_ImpSheet

.Cells(myCount, 1) = o_FolderItem.Path & "\ (DIR)" 'サブフォルダのフルパスの書込み。「(DIR)」という目印あり。

' .Cells(myCount, 1) = o_FolderItem.Path '同上。目印なし。

' .Cells(myCount, 2) = Int(o_FolderItem.Size / 1024) 'サブフォルダのKBでの容量（整数。右クリックプロパティの「サイズ」の値に合わせない。）

.Cells(myCount, 3) = o_FolderItem.Type 'オブジェクトの種類（フォルダ、××ファイル、など）

.Cells(myCount, 4) = o_FolderItem.DateCreated 'サブフォルダの作成日

.Cells(myCount, 5) = o_FolderItem.DateLastAccessed 'サブフォルダの最終アクセス日時

.Cells(myCount, 6) = o_FolderItem.DateLastModified 'サブフォルダの最終更新日

End With

'↑ファイル情報を吸い込みたいシートに、具体内容を吸い込む。

Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, myCount)

'↑サブフォルダのサブフォルダを、（再帰的に）終わるまでどんどん掘っていく。

'　サブフォルダが見つかるたびに、更に掘っていく。

End Function

'####################################################

'現在のフォルダの中でのループに、させたい内容

'通常は、こっちがメイン。

' '◆◆◆ つまり、コメントアウトしちゃダメ！

' '◆◆◆ ただし、アクティブシートに何もしない場合は

' '◆◆◆ 該当するコードは消すか修正する。

'引数は、TPO・目的によって、増やしたり減らしたり無くしたりする。

'また、参照渡しで、呼び出しモトの引数をそのまま引き継いでいます。

'####################################################

Function CurrentFolderWork01(o_ImpSheet As Worksheet, _

s_folderPath As String, _

myCount As Long, _

o_FileItem As Object)

'オブジェクト変数「o_FileItem」は、FSOを呼び出しモトでインスタンス化してしまっているので、

'この段階では固有型の「File」にはできず、総称型の「Object」にしかできない。

' With Ws01

With o_ImpSheet

.Cells(myCount, 1) = o_FileItem.Path 'ファイルのフルパスを書き込む

' .Cells(myCount, 2) = Int(o_FileItem.Size / 1024) 'ファイルの容量（整数。KB単位。プロパティの「サイズ」の値に合わせない。）

.Cells(myCount, 3) = o_FileItem.Type 'ファイルの種類

.Cells(myCount, 4) = o_FileItem.DateCreated 'ファイルの作成日

.Cells(myCount, 5) = o_FileItem.DateLastAccessed 'ファイルの最終アクセス日

.Cells(myCount, 6) = o_FileItem.DateLastModified 'ファイルの最終更新日

End With

End Function

　　
　　
★ 冒頭のコードを、「特定の拡張子の、特定の語句をファイル名に含むファイルをリストアップする例」に修正してみたもの

※対象はファイルのみ、で、フォルダに対しての情報は得ないものとする。

'
'

'
Option Explicit
 
'####################################################
'すべてのファイルとフォルダの情報を調べたい、
'その「フォルダ」と、
'その情報を吸い込みたいシートを指定する処理。
'####################################################
 
Sub GetFolderAndFileListMain02()

 
    Dim o_AnswFDialg    As FileDialog
    Dim s_PickFldPath   As String
    Dim o_ImpWs01       As Worksheet
    Dim s_KenssakuGoku  As String
    Dim s_Kakutyousi    As String

    '★ 設定部

    s_KenssakuGoku = "Q"
    '↑検索したいファイル名の語句
    
    s_Kakutyousi = "pdf"
    '↑検索したいファイルの拡張子（ドット不要）
  
    Set o_AnswFDialg = Application. _
                        FileDialog(msoFileDialogFolderPicker)
    '↑ファイル選択ダイアログを使えるように準備。
    


    Set o_ImpWs01 = ActiveWorkbook. _
                             ActiveSheet
    '↑ファイル情報を吸い込むシートをアクティブシートに指定。
    
    
    
    '★ 実動部

    If Not o_AnswFDialg.Show Then
        Exit Sub
        '↑キャンセルされたときは終わる。
    Else
        s_PickFldPath = o_AnswFDialg.SelectedItems(1)
        '↑フォルダが選択されたら、
        '　ファイル選択ダイアログのオブジェクトの
        '「SelectedItems プロパティ」にフォルダパスが
        '　自動的にゲットされるので、
        '　一時的な処理として、いったん適当な変数にそれをメモ代入。
    End If
    '↑ファイル選択ダイアログを実際に開き、
    '　フォルダが選択されたら（＝フォルダパスがゲットできたら）
    '　そのパスを一時保管して次へ行き、
    '　キャンセルされたらプログラムを終わる。


    o_ImpWs01.Cells.ClearContents
    '↑いったん、指定したシートをオールクリアして真っ白にする。
    
    
    With o_ImpWs01
        .Range("A1") = "パス"
        .Range("B1") = "容量（KB）"
        .Range("C1") = "種類"
        .Range("D1") = "作成日時"
        .Range("E1") = "アクセス日時"
        .Range("F1") = "更新日時"
    End With
    '↑指定したシートに列名（項目名）を書き込む


    Call GetFolderAndFileListSub(o_ImpSheet:=o_ImpWs01, _
                                 s_folderPath:=s_PickFldPath, _
                                 s_SearchWord:=s_KenssakuGoku, _
                                 s_Extention:=s_Kakutyousi)

    '↑リスト作成の実行。
    '　ピックアップされたフォルダバスの中を、
    '　すべてのサブフォルダのすべてのファイルを対象に、
    '　o_ImpWs01 に指定したシートにファイル情報を吸い込む（＝書き込む）。
    
    
    
End Sub



'####################################################
'実際にすべてのサブフォルダたちとファイルたちの、
'ファイルとフォルダの基本情報を、
'指定したシートに吸い込む処理。
'####################################################


 
Sub GetFolderAndFileListSub(o_ImpSheet As Worksheet, _
                            s_folderPath As String, _
                            s_SearchWord As String, _
                            s_Extention As String, _
                            Optional myCount As Long = 1)

   
    Dim FSO As Object
    Dim o_FolderItem As Object
    Dim o_FileItem As Object

    

    '★ 設定部
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    '↑参照設定しなくてもFSO（FileSystemObject）を使えるようにする。

    On Error Resume Next
        
        
        
    '★ 実働部
        
    'サブフォルダを再帰的に覗いていって処理。
    For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders
         
        '※ファイルのみでフォルダに対しての情報は得ないものとするので、
        '  ここには何も書かずに、下記のフォルダの掘り下げコードのみとする。

        Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, s_SearchWord, s_Extention, myCount)
        '↑サブフォルダのサブフォルダを、（再帰的に）終わるまでどんどん掘っていく「だけ」の処理。
        '　サブフォルダが見つかるたびに、更に掘っていく。

    Next o_FolderItem
    '↑「サブフォルダのみを延々と深く最後まで掘っていくループ
    '　（この段階ではサブフォルダのフォルダ情報のみをゲット。
    '　　サブフォルダ内のファイルたちの情報は次の段階のForEachループでゲット。）
'

       

    '現在のフォルダの中「だけ」の、ファイル一覧の書き出し。（サブフォルダも含む）
    'コメント内容は前述の「サブフォルダ延々掘り」のときとおおむね同じ。（フォルダ情報がファイル情報になっただけ）
    For Each o_FileItem In FSO.GetFolder(s_folderPath).Files
    
        myCount = myCount + 1


        With o_ImpSheet
            
            If FSO.GetextensionName(o_FileItem.Path) = s_Extention Then
            '↑探す対象のファイルをPDFファイルだけに固定
            'すべてのファイルが対象なら、このIF文をコメントアウト。
            
                If 1 <= InStr(1, o_FileItem.Name, s_SearchWord, vbBinaryCompare) Then
                '↑指定した語句を含むPDFファイルだけ、以下の処理。
                
                    .Cells(myCount, 1) = o_FileItem.Path
                    '↑ファイルのフルパスを書き込む
                Else
                    myCount = myCount - 1
                    '↑条件にヒットしないファイルのときに、
                    '　空の行ができてしまうのを防ぐために
                    '　「-1」しておく。
                End If
                
            Else
                myCount = myCount - 1
                    '↑条件にヒットしないファイルのときに、
                    '　空の行ができてしまうのを防ぐために
                    '　「-1」しておく。
            End If
            
        End With
        
    Next o_FileItem
        

 
End Sub
'
'




'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

Option Explicit

'####################################################

'すべてのファイルとフォルダの情報を調べたい、

'その「フォルダ」と、

'その情報を吸い込みたいシートを指定する処理。

'####################################################

Sub GetFolderAndFileListMain02()

Dim o_AnswFDialg As FileDialog

Dim s_PickFldPath As String

Dim o_ImpWs01 As Worksheet

Dim s_KenssakuGoku As String

Dim s_Kakutyousi As String

'★ 設定部

s_KenssakuGoku = "Q"

'↑検索したいファイル名の語句

s_Kakutyousi = "pdf"

'↑検索したいファイルの拡張子（ドット不要）

Set o_AnswFDialg = Application. _

FileDialog(msoFileDialogFolderPicker)

'↑ファイル選択ダイアログを使えるように準備。

Set o_ImpWs01 = ActiveWorkbook. _

ActiveSheet

'↑ファイル情報を吸い込むシートをアクティブシートに指定。

'★ 実動部

If Not o_AnswFDialg.Show Then

Exit Sub

'↑キャンセルされたときは終わる。

Else

s_PickFldPath = o_AnswFDialg.SelectedItems(1)

'↑フォルダが選択されたら、

'　ファイル選択ダイアログのオブジェクトの

'「SelectedItems プロパティ」にフォルダパスが

'　自動的にゲットされるので、

'　一時的な処理として、いったん適当な変数にそれをメモ代入。

End If

'↑ファイル選択ダイアログを実際に開き、

'　フォルダが選択されたら（＝フォルダパスがゲットできたら）

'　そのパスを一時保管して次へ行き、

'　キャンセルされたらプログラムを終わる。

o_ImpWs01.Cells.ClearContents

'↑いったん、指定したシートをオールクリアして真っ白にする。

With o_ImpWs01

.Range("A1") = "パス"

.Range("B1") = "容量（KB）"

.Range("C1") = "種類"

.Range("D1") = "作成日時"

.Range("E1") = "アクセス日時"

.Range("F1") = "更新日時"

End With

'↑指定したシートに列名（項目名）を書き込む

Call GetFolderAndFileListSub(o_ImpSheet:=o_ImpWs01, _

s_folderPath:=s_PickFldPath, _

s_SearchWord:=s_KenssakuGoku, _

s_Extention:=s_Kakutyousi)

'↑リスト作成の実行。

'　ピックアップされたフォルダバスの中を、

'　すべてのサブフォルダのすべてのファイルを対象に、

'　o_ImpWs01 に指定したシートにファイル情報を吸い込む（＝書き込む）。

End Sub

'####################################################

'実際にすべてのサブフォルダたちとファイルたちの、

'ファイルとフォルダの基本情報を、

'指定したシートに吸い込む処理。

'####################################################

Sub GetFolderAndFileListSub(o_ImpSheet As Worksheet, _

s_folderPath As String, _

s_SearchWord As String, _

s_Extention As String, _

Optional myCount As Long = 1)

Dim FSO As Object

Dim o_FolderItem As Object

Dim o_FileItem As Object

'★ 設定部

Set FSO = CreateObject("Scripting.FileSystemObject")

'↑参照設定しなくてもFSO（FileSystemObject）を使えるようにする。

On Error Resume Next

'★ 実働部

'サブフォルダを再帰的に覗いていって処理。

For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders

'※ファイルのみでフォルダに対しての情報は得ないものとするので、

' ここには何も書かずに、下記のフォルダの掘り下げコードのみとする。

Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, s_SearchWord, s_Extention, myCount)

'↑サブフォルダのサブフォルダを、（再帰的に）終わるまでどんどん掘っていく「だけ」の処理。

'　サブフォルダが見つかるたびに、更に掘っていく。

Next o_FolderItem

'↑「サブフォルダのみを延々と深く最後まで掘っていくループ

'　（この段階ではサブフォルダのフォルダ情報のみをゲット。

'　　サブフォルダ内のファイルたちの情報は次の段階のForEachループでゲット。）

'現在のフォルダの中「だけ」の、ファイル一覧の書き出し。（サブフォルダも含む）

'コメント内容は前述の「サブフォルダ延々掘り」のときとおおむね同じ。（フォルダ情報がファイル情報になっただけ）

For Each o_FileItem In FSO.GetFolder(s_folderPath).Files

myCount = myCount + 1

With o_ImpSheet

If FSO.GetextensionName(o_FileItem.Path) = s_Extention Then

'↑探す対象のファイルをPDFファイルだけに固定

'すべてのファイルが対象なら、このIF文をコメントアウト。

If 1 <= InStr(1, o_FileItem.Name, s_SearchWord, vbBinaryCompare) Then

'↑指定した語句を含むPDFファイルだけ、以下の処理。

.Cells(myCount, 1) = o_FileItem.Path

'↑ファイルのフルパスを書き込む

Else

myCount = myCount - 1

'↑条件にヒットしないファイルのときに、

'　空の行ができてしまうのを防ぐために

'　「-1」しておく。

End If

Else

myCount = myCount - 1

'↑条件にヒットしないファイルのときに、

'　空の行ができてしまうのを防ぐために

'　「-1」しておく。

End If

End With

Next o_FileItem

End Sub

　　
　　
★ 冒頭のコードを、「”すべて”の拡張子の、特定の語句をファイル名に含むファイルをリストアップする例」に修正してみたもの

※対象はファイルのみ、で、フォルダに対しての情報は得ないものとする。

'
'

'
Option Explicit
 
'####################################################
'すべてのファイルとフォルダの情報を調べたい、
'その「フォルダ」と、
'その情報を吸い込みたいシートを指定する処理。
'####################################################
 
Sub GetFolderAndFileListMain02()

 
    Dim o_AnswFDialg    As FileDialog
    Dim s_PickFldPath   As String
    Dim o_ImpWs01       As Worksheet
    Dim s_KenssakuGoku  As String
    Dim s_Kakutyousi    As String

    '★ 設定部

    s_KenssakuGoku = "."
    '↑検索したいファイル名の語句
    
'    s_Kakutyousi = "pdf"
    '↑検索したいファイルの拡張子（ドット不要）
  
    Set o_AnswFDialg = Application. _
                        FileDialog(msoFileDialogFolderPicker)
    '↑ファイル選択ダイアログを使えるように準備。
    


    Set o_ImpWs01 = ActiveWorkbook. _
                             ActiveSheet
    '↑ファイル情報を吸い込むシートをアクティブシートに指定。
    
    
    
    '★ 実動部

    If Not o_AnswFDialg.Show Then
        Exit Sub
        '↑キャンセルされたときは終わる。
    Else
        s_PickFldPath = o_AnswFDialg.SelectedItems(1)
        '↑フォルダが選択されたら、
        '　ファイル選択ダイアログのオブジェクトの
        '「SelectedItems プロパティ」にフォルダパスが
        '　自動的にゲットされるので、
        '　一時的な処理として、いったん適当な変数にそれをメモ代入。
    End If
    '↑ファイル選択ダイアログを実際に開き、
    '　フォルダが選択されたら（＝フォルダパスがゲットできたら）
    '　そのパスを一時保管して次へ行き、
    '　キャンセルされたらプログラムを終わる。


    o_ImpWs01.Cells.ClearContents
    '↑いったん、指定したシートをオールクリアして真っ白にする。
    
    
    With o_ImpWs01
        .Range("A1") = "パス"
        .Range("B1") = "容量（KB）"
        .Range("C1") = "種類"
        .Range("D1") = "作成日時"
        .Range("E1") = "アクセス日時"
        .Range("F1") = "更新日時"
    End With
    '↑指定したシートに列名（項目名）を書き込む


    Call GetFolderAndFileListSub(o_ImpSheet:=o_ImpWs01, _
                                 s_folderPath:=s_PickFldPath, _
                                 s_SearchWord:=s_KenssakuGoku, _
                                 s_Extention:=s_Kakutyousi)

    '↑リスト作成の実行。
    '　ピックアップされたフォルダバスの中を、
    '　すべてのサブフォルダのすべてのファイルを対象に、
    '　o_ImpWs01 に指定したシートにファイル情報を吸い込む（＝書き込む）。
    
    
    
End Sub



'####################################################
'実際にすべてのサブフォルダたちとファイルたちの、
'ファイルとフォルダの基本情報を、
'指定したシートに吸い込む処理。
'####################################################


 
Sub GetFolderAndFileListSub(o_ImpSheet As Worksheet, _
                            s_folderPath As String, _
                            s_SearchWord As String, _
                            s_Extention As String, _
                            Optional myCount As Long = 1)

   
    Dim FSO As Object
    Dim o_FolderItem As Object
    Dim o_FileItem As Object

    

    '★ 設定部
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    '↑参照設定しなくてもFSO（FileSystemObject）を使えるようにする。

    On Error Resume Next
        
        
        
    '★ 実働部
        
    'サブフォルダを再帰的に覗いていって処理。
    For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders
         
        '※ファイルのみでフォルダに対しての情報は得ないものとするので、
        '  ここには何も書かずに、下記のフォルダの掘り下げコードのみとする。

        Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, s_SearchWord, s_Extention, myCount)
        '↑サブフォルダのサブフォルダを、（再帰的に）終わるまでどんどん掘っていく「だけ」の処理。
        '　サブフォルダが見つかるたびに、更に掘っていく。

    Next o_FolderItem
    '↑「サブフォルダのみを延々と深く最後まで掘っていくループ
    '　（この段階ではサブフォルダのフォルダ情報のみをゲット。
    '　　サブフォルダ内のファイルたちの情報は次の段階のForEachループでゲット。）
'

       

    '現在のフォルダの中「だけ」の、ファイル一覧の書き出し。（サブフォルダも含む）
    'コメント内容は前述の「サブフォルダ延々掘り」のときとおおむね同じ。（フォルダ情報がファイル情報になっただけ）
    For Each o_FileItem In FSO.GetFolder(s_folderPath).Files
    
        myCount = myCount + 1


        With o_ImpSheet
            
            'If FSO.GetextensionName(o_FileItem.Path) = s_Extention Then
            ''↑探す対象のファイルをPDFファイルだけに固定
            ''すべてのファイルが対象なら、このIF文をコメントアウト。
            
                If 1 <= InStr(1, o_FileItem.Name, s_SearchWord, vbBinaryCompare) Then
                '↑指定した語句を含むPDFファイルだけ、以下の処理。
                
                    .Cells(myCount, 1) = o_FileItem.Path
                    '↑ファイルのフルパスを書き込む
                Else
                    myCount = myCount - 1
                    '↑条件にヒットしないファイルのときに、
                    '　空の行ができてしまうのを防ぐために
                    '　「-1」しておく。
                End If
                
            'Else
            '    myCount = myCount - 1
            '        '↑条件にヒットしないファイルのときに、
            '        '　空の行ができてしまうのを防ぐために
            '        '　「-1」しておく。
            'End If
            
        End With
        
    Next o_FileItem
        

 
End Sub
'
'




'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

Option Explicit

'####################################################

'すべてのファイルとフォルダの情報を調べたい、

'その「フォルダ」と、

'その情報を吸い込みたいシートを指定する処理。

'####################################################

Sub GetFolderAndFileListMain02()

Dim o_AnswFDialg As FileDialog

Dim s_PickFldPath As String

Dim o_ImpWs01 As Worksheet

Dim s_KenssakuGoku As String

Dim s_Kakutyousi As String

'★ 設定部

s_KenssakuGoku = "."

'↑検索したいファイル名の語句

' s_Kakutyousi = "pdf"

'↑検索したいファイルの拡張子（ドット不要）

Set o_AnswFDialg = Application. _

FileDialog(msoFileDialogFolderPicker)

'↑ファイル選択ダイアログを使えるように準備。

Set o_ImpWs01 = ActiveWorkbook. _

ActiveSheet

'↑ファイル情報を吸い込むシートをアクティブシートに指定。

'★ 実動部

If Not o_AnswFDialg.Show Then

Exit Sub

'↑キャンセルされたときは終わる。

Else

s_PickFldPath = o_AnswFDialg.SelectedItems(1)

'↑フォルダが選択されたら、

'　ファイル選択ダイアログのオブジェクトの

'「SelectedItems プロパティ」にフォルダパスが

'　自動的にゲットされるので、

'　一時的な処理として、いったん適当な変数にそれをメモ代入。

End If

'↑ファイル選択ダイアログを実際に開き、

'　フォルダが選択されたら（＝フォルダパスがゲットできたら）

'　そのパスを一時保管して次へ行き、

'　キャンセルされたらプログラムを終わる。

o_ImpWs01.Cells.ClearContents

'↑いったん、指定したシートをオールクリアして真っ白にする。

With o_ImpWs01

.Range("A1") = "パス"

.Range("B1") = "容量（KB）"

.Range("C1") = "種類"

.Range("D1") = "作成日時"

.Range("E1") = "アクセス日時"

.Range("F1") = "更新日時"

End With

'↑指定したシートに列名（項目名）を書き込む

Call GetFolderAndFileListSub(o_ImpSheet:=o_ImpWs01, _

s_folderPath:=s_PickFldPath, _

s_SearchWord:=s_KenssakuGoku, _

s_Extention:=s_Kakutyousi)

'↑リスト作成の実行。

'　ピックアップされたフォルダバスの中を、

'　すべてのサブフォルダのすべてのファイルを対象に、

'　o_ImpWs01 に指定したシートにファイル情報を吸い込む（＝書き込む）。

End Sub

'####################################################

'実際にすべてのサブフォルダたちとファイルたちの、

'ファイルとフォルダの基本情報を、

'指定したシートに吸い込む処理。

'####################################################

Sub GetFolderAndFileListSub(o_ImpSheet As Worksheet, _

s_folderPath As String, _

s_SearchWord As String, _

s_Extention As String, _

Optional myCount As Long = 1)

Dim FSO As Object

Dim o_FolderItem As Object

Dim o_FileItem As Object

'★ 設定部

Set FSO = CreateObject("Scripting.FileSystemObject")

'↑参照設定しなくてもFSO（FileSystemObject）を使えるようにする。

On Error Resume Next

'★ 実働部

'サブフォルダを再帰的に覗いていって処理。

For Each o_FolderItem In FSO.GetFolder(s_folderPath).subfolders

'※ファイルのみでフォルダに対しての情報は得ないものとするので、

' ここには何も書かずに、下記のフォルダの掘り下げコードのみとする。

Call GetFolderAndFileListSub(o_ImpSheet, o_FolderItem.Path, s_SearchWord, s_Extention, myCount)

'↑サブフォルダのサブフォルダを、（再帰的に）終わるまでどんどん掘っていく「だけ」の処理。

'　サブフォルダが見つかるたびに、更に掘っていく。

Next o_FolderItem

'↑「サブフォルダのみを延々と深く最後まで掘っていくループ

'　（この段階ではサブフォルダのフォルダ情報のみをゲット。

'　　サブフォルダ内のファイルたちの情報は次の段階のForEachループでゲット。）

'現在のフォルダの中「だけ」の、ファイル一覧の書き出し。（サブフォルダも含む）

'コメント内容は前述の「サブフォルダ延々掘り」のときとおおむね同じ。（フォルダ情報がファイル情報になっただけ）

For Each o_FileItem In FSO.GetFolder(s_folderPath).Files

myCount = myCount + 1

With o_ImpSheet

'If FSO.GetextensionName(o_FileItem.Path) = s_Extention Then

''↑探す対象のファイルをPDFファイルだけに固定

''すべてのファイルが対象なら、このIF文をコメントアウト。

If 1 <= InStr(1, o_FileItem.Name, s_SearchWord, vbBinaryCompare) Then

'↑指定した語句を含むPDFファイルだけ、以下の処理。

.Cells(myCount, 1) = o_FileItem.Path

'↑ファイルのフルパスを書き込む

Else

myCount = myCount - 1

'↑条件にヒットしないファイルのときに、

'　空の行ができてしまうのを防ぐために

'　「-1」しておく。

End If

'Else

' myCount = myCount - 1

' '↑条件にヒットしないファイルのときに、

' '　空の行ができてしまうのを防ぐために

' '　「-1」しておく。

'End If

End With

Next o_FileItem

End Sub

MENU

★ 指定したフォルダ内の、すべてのサブフォルダを延々と掘っていって、『すべてのファイルとすべてのサブフォルダ』の基本情報を指定したシートにゲットする（吸い込む）プログラム。（再帰的な処理）

関連記事

最近の投稿

カテゴリー

MENU

★ 指定したフォルダ内の、すべてのサブフォルダを延々と掘っていって、『 すべてのファイルとすべてのサブフォルダ 』の基本情報を指定したシートにゲットする（吸い込む）プログラム。（再帰的な処理）

関連記事

最近の投稿

カテゴリー

タグ

★ 指定したフォルダ内の、すべてのサブフォルダを延々と掘っていって、『すべてのファイルとすべてのサブフォルダ』の基本情報を指定したシートにゲットする（吸い込む）プログラム。（再帰的な処理）