Excel VBAどこが間違ってますか？

下記のVBAで間違っているとこがあれば教えてください。うまく動作しません。
やりたいこと
・特定のフォルダー内に複数のフォルダーがありその中にExcelファイルがあります。
そのExcelファイルのファイル名を抽出してExcelシートに一覧で表示させたい。
※フォルダー内にファイルが多いため更新日時の日付を指定してそれ以降のファイルのみ抽出したい

Sub GetUpdatedExcelFiles()
Dim folderPath As String
Dim fileName As String
Dim lastRow As Long
Dim fileDate As Date
Dim currentDate As Date

' フォルダーパスを指定
folderPath = "C:\YourFolderPath\"

' シート1のA1セルの日付を取得
currentDate = Sheets("Sheet1").Range("A1").Value

' 初期行を設定
lastRow = 3

' フォルダ内の全てのファイルに対してループ処理
fileName = Dir(folderPath & "*.xls*")
Do While fileName <> ""
' ファイルの更新日を取得
fileDate = FileDateTime(folderPath & fileName)

' 更新日が現在の日付以降の場合、ファイル名を表示
If fileDate >= currentDate Then
Sheets("Sheet1").Cells(lastRow, 1).Value = fileName
lastRow = lastRow + 1
End If

' 次のファイルに進む
fileName = Dir
Loop

' メッセージボックスで処理完了を表示
MsgBox "Excelファイルの一覧を取得しました。"
End Sub

おかしい箇所があれば教えてください。

No.4 回答者： tatsumaru77 回答日時： 2023/07/18 08:21

>こちらは二つのマクロが有ると言うことでいいのでしょうか？

はい。その通りです。
Sub Excelファイル再帰検索　を実行してください。
そうすると、Sub　Excelファイル再帰検索からSub displayが
呼び出されます。
その結果、Excelファイルの一覧が作成されます。

No.3 回答者： tatsumaru77 回答日時： 2023/07/17 21:02

No2です。

folderPath = "d:\goo\excel"　はこちらで試験した環境です。
あなたの環境の
folderPath = "C:\YourFolderPath"　に設定してください。
最後の\は、つけないでください。

No.2 回答者： tatsumaru77 回答日時： 2023/07/17 13:43

サブフォルダ内のファイルも含めて表示するには再帰処理がひつようになります。

Dir関数が再帰処理に適合しないと思われますので、FileSystemObjectを使用します。
従って、作り直しになります。
以下のようにしてください。
Option Explicit
Dim FSO As Object
Dim fileName As String
Dim lastRow As Long
Dim fileDate As Date
Dim currentDate As Date
Dim ws As Worksheet
Dim REG As Object
Public Sub Excelファイル再帰検索()
Dim folderPath As String
folderPath = "d:\goo\excel"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ws = Worksheets("Sheet1")
currentDate = ws.Range("A1").Value
lastRow = 3
ws.Rows("3:" & Rows.Count).ClearContents
Set REG = CreateObject("VBScript.RegExp")
REG.Pattern = "^.+\.xls.*$"
REG.IgnoreCase = True
Call display(folderPath)
MsgBox "Excelファイルの一覧を取得しました。"
End Sub
Private Sub display(ByVal path As String)
Dim trgfolder As Object
Dim wfiles As Object
Dim wfile As Object
Dim wsubfolders As Object
Dim wsubfolder As Object
Set trgfolder = FSO.GetFolder(path)
Set wfiles = trgfolder.Files
Set wsubfolders = trgfolder.Subfolders
For Each wfile In wfiles
If wfile.datelastmodified >= currentDate Then
If REG.test(wfile.Name) = True Then
ws.Cells(lastRow, 1).Value = wfile.Name
lastRow = lastRow + 1
End If
End If
Next
For Each wsubfolder In wsubfolders
display (wsubfolder.path)
Next
End Sub

不明点があれば、補足してください。

この回答へのお礼

返信ありがとうございます。
こちらは二つのマクロが有ると言うことでいいのでしょうか？そのまま貼り付けたところ分割されたのですが？

お礼日時：2023/07/17 23:28

No.1 回答者： tatsumaru77 回答日時： 2023/07/17 10:51

「うまく動作しません。

」とは、具体的にどういう現象なのでしょうか。

こちらで、確認したところ、正しく動作しています。
（folderPathの内容はこちらの環境です）

もし、「folderPath = "C:\YourFolderPath\"　の下にサブフォルダがあり、
そのサブフォルダ内のexcelファイルも一覧に表示したい」ということでしたら、このマクロでは対応していません。

この回答へのお礼

返信ありがとうございます。
フォルダー内にフォルダー1、2、3と別フォルダーがありその中のExcelファイル名を抽出したいです

お礼日時：2023/07/17 11:38