VBAでフォルダ内のファイルの一覧表を作りたい

質問

お世話になります。

表題につき過去にここで教わって（https://okwave.jp/qa/q10129448.html）
毎月数千件のPDFファイルの一覧を作成して非常に助かっているのですが、最近対象ファイルにエクセルやワードもリストアップしたくコードの一部に対象ファイルの拡張子を付け加えてみたのですが、の追加により検索対象フォルダが第1階層までしか検索しなくなってしまっていることに気付きました。

どこを修正すれば良いのでしょう。

★修正前コード（指定のフォルダ内の子や孫フォルダまで検索）
'PDFファイルを個々に取得(対象拡張子)
For Each objFile In FSO.GetFolder(path).Files
If UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then
execute objFile
End If
Next

☆修正後（親フォルダしか検索しなくなった）
'PDFファイルを個々に取得(対象拡張子)
For Each objFile In FSO.GetFolder(path).Files
If UCase(FSO.GetExtensionName(objFile.path)) = "DOCX" Or _
UCase(FSO.GetExtensionName(objFile.path)) = "XLSM" Or _
UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then
execute objFile
End If
Next

回答No.4

HohoPapa · ベストアンサー

私の環境、コードでは、現象が再現できないので、
まず、
後記のように、
Debug.Print path
を追加し、実行し、
イミディエイト画面を確認し、確認結果を教えて下さい。

ここには、処理の対象としたフォルダーたちが並びます。

Sub getFilesRecursive(path As String)

Debug.Print path　　'追加はこれです！！！

Dim FSO As FileSystemObject: Set FSO = New FileSystemObject
Dim objFolder As folder
Dim objFile As file

'フォルダーを個々に取得
For Each objFolder In FSO.GetFolder(path).SubFolders
getFilesRecursive objFolder.path
Next

' 'ファイルを個々に取得
' For Each objFile In FSO.GetFolder(path).Files
' If UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then
' execute objFile
' End If
' Next
'

'☆修正後 (親フォルダしか検索しなくなった)
'PDFファイルを個々に取得(対象拡張子)
For Each objFile In FSO.GetFolder(path).Files
If UCase(FSO.GetExtensionName(objFile.path)) = "DOCX" Or _
UCase(FSO.GetExtensionName(objFile.path)) = "XLSM" Or _
UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then
execute objFile
End If
Next

End Sub

お礼

お掛けしてしまいました。何ともお粗末な結果でしたが久しぶりにワクワク感がありました。 当方来月古稀ですので、後しばらくの間何卒宜しくお願い致します。

Powered by GRATICA

補足

おはようございます。

そちらでは再現しないとのご回答なので、当方のいじった部分のコード（拡張子の追加）は影響しない、と言うことだと考え朝から再度検索結果（件数）を検証してみました。
結果、
誠にお恥ずかしい限りですが、２か月前にこの検索シートのコードをいじる時に、コピーを作成し間違わないように違う場所に保管してあったので、今回は違う検索シートで実行したと思います。
それぞれの結果シートに抽出されていたようです。
各検索エクセルでそれぞれ指定のｼｰﾄに結果が出力されていたということです。
いつもならTEST 1とかファイル名を変えるのに変えなかったのが失敗。

ルーティンの検索エクセルの起動はショートカットだったためにどのフォルダのエクセルか意識していませんでした。
結局いじったのはTEST用で、使用したエクセルはショートカットのエクセルを使用していたということでした。

こんなわたくしですが、今後とも見捨てることなく宜しくお願します。

現在、ここで教えて頂いたほぼすべてのVBAが活躍していますが、特にHohoPapa関数（指定した列の下から指定個数の統計データ関数）や列の１行目に指定した数での作グラフVBAは毎日いくつものシートで活躍しています。

回答No.3

HohoPapa

私が過去にポストしたコードらしく、
有効活用してくれているのはうれしい限りです。

後記のコードで、
'////////////////////////ここから
'////////////////////////ここまで
の間のコードを削除してしまっていませんでしょうか。

'フォルダー、ファイルを総当たり
Sub getFilesRecursive(path As String)

Dim FSO As FileSystemObject: Set FSO = New FileSystemObject
Dim objFolder As folder
Dim objFile As file

'////////////////////////ここから
'ファイルを個々に取得
For Each objFile In FSO.GetFolder(path).Files
If UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then
execute objFile
End If
Next
'////////////////////////ここまで

'★修正前コード（指定のフォルダ内の子や孫フォルダまで検索）
'PDFファイルを個々に取得(対象拡張子)
' For Each objFile In FSO.GetFolder(path).Files
' If UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then
' execute objFile
' End If
' Next
'

'☆修正後 (親フォルダしか検索しなくなった)
'PDFファイル、ワードファイル、エクセルファイルを個々に取得(対象拡張子)
For Each objFile In FSO.GetFolder(path).Files
If UCase(FSO.GetExtensionName(objFile.path)) = "DOCX" Or _
UCase(FSO.GetExtensionName(objFile.path)) = "XLSM" Or _
UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then
execute objFile
End If
Next

End Sub

補足

HohoPapa-さん
久しぶりにお手数をお掛けします。
毎日 誰かが何らかのエクセルで過去のご回答で大変お世話になっています。
最近はこのような改善（と言っても殆ど過去のご回答とマクロの記録をCallで繋ぐ程度）で間に合うようになってきていますのでここへの質問も頻度が下がっています。

下記が実際に記載してあるコードのコピーで、ご指摘のコードの削除は無いと思います。

また、pdf以外の拡張子（XLSX）を追加したBookではチャンとエクセルもリストアップされることは確認しています。
但し、このＢookは親フォルダーだけなので、今回の親フォルダーの下の階層のフォルダがある場合の、複数の拡張子のケースはこれが初めてで過去2ヶ月間はエクセルがリストアップされていないことに気付きませんでした。
リストの下の方まで確認していませんでした。

フォルダ内のファイル件数とリストの件数が2－300件合わないので気づいた次第です。
＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞＞
'フォルダー、ファイルを総当たり
Sub getFilesRecursive(path As String)

Dim FSO As FileSystemObject: Set FSO = New FileSystemObject
Dim objFolder As folder
Dim objFile As file

'フォルダーを個々に取得
For Each objFolder In FSO.GetFolder(path).SubFolders
getFilesRecursive objFolder.path
Next

'ファイルを個々に取得
For Each objFile In FSO.GetFolder(path).Files
If UCase(FSO.GetExtensionName(objFile.path)) = "DOCX" Or _
UCase(FSO.GetExtensionName(objFile.path)) = "XLSX " Or _
UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then
execute objFile
End If
Next

End Sub

回答No.2

kkkkkm

'作成日時が指定日より過去のファイルは無視する
　If f.DateCreated < BorderDay Then Exit Sub

実行時に過去のファイルが無かったので親フォルダしか検索しかしていないように見えたとかの可能性はありませんか

あと、ファイルの種類ごとに個別に同じコードで

If UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then

だけそれぞれ変えて作成して試してみるとか

回答No.1

kon555

元々の質問を見ると結構複雑な要件とコードですね。
　ただ「親フォルダしか検索しなくなった」＝親フォルダは検索できている、と考えると純粋にコードとしておかしくなっているというわけでもなさそうです。

　半ば勘ですが、
If UCase(FSO.GetExtensionName(objFile.path)) = "DOCX" Or _
UCase(FSO.GetExtensionName(objFile.path)) = "XLSM" Or _
UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then
execute objFile
End If
　の部分を
If UCase(FSO.GetExtensionName(objFile.path)) = "DOCX" Then
execute objFile
End If
If UCase(FSO.GetExtensionName(objFile.path)) = "XLSM" Then
execute objFile
End If
If UCase(FSO.GetExtensionName(objFile.path)) = "PDF" Then
execute objFile
End If
　と個別に記述してみてください。

　また、ステップ実行や変数の確認などで、元々のコードと貴方が修正したコードで、具体的に処理がどう違っているのか？　を確認すると解決しやすくなります。いわゆるデバッグです。
https://www.239-programing.com/excel-vba/basic/basic021.html
https://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_030_03.html
　こうした質問サイトで他人が作ったコードを修正するのは大変なので、自力で最低限のデバッグはできるようになる事をおススメします。