ファイル検索

特定のフォルダ以下を検索します。
3種類の検索方法を例として記載しています。

---

1. フォルダ検索をして全てのファイルを Debug.Print します。Debug.Print はイミディエイトウィンドウで確認できます。 (サブフォルダを検索しません)

' ------------------------------------------------------------
' 説明：ファイルを検索します
' 引数：1:ファイルパス
' 補足：サブフォルダは検索しません
' ------------------------------------------------------------
Sub FindFileList(file_path As Variant)
	Dim path As Variant
	Dim fso As Scripting.FileSystemObject
	Set fso = New Scripting.FileSystemObject

	' フォルダ内のファイルを検索
	For Each path In fso.GetFolder(file_path).Files
		' ここに処理を入れます
		Debug.Print path
	Next
End Sub

---

2. フォルダ検索をして全てのファイルを Debug.Print します。Debug.Print はイミディエイトウィンドウで確認できます。 (サブフォルダを検索します)

Sub GetFileList(path As String)
	Dim fso As Scripting.FileSystemObject
	Set fso = New Scripting.FileSystemObject

	' ファイルを検索
	FindFileList fso, path
End Sub

' ------------------------------------------------------------
' 説明：ファイルを検索します
' 引数：1:FileSystemObject の Object
'       2:ファイルパス
' 補足：サブフォルダも検索します
' ------------------------------------------------------------
Sub FindFileList(fso As Scripting.FileSystemObject, parent_path As Variant)
	Dim path As Variant

	' フォルダ内のサブフォルダを検索
	For Each path In fso.GetFolder(parent_path).SubFolders
		'Debug.Print path
		Call FindFileList(fso, path)        ' 再帰検索
	Next

	' フォルダ内のファイルを検索
	For Each path In fso.GetFolder(parent_path).Files
		' ここに処理を入れます
		Debug.Print path
	Next
End Sub

---

3. ファイルの拡張子を選別できるようにします。 (サブフォルダを検索します)

Sub GetFileListExp(path As String)
	Dim exp_list As String
	Dim fso As Scripting.FileSystemObject
	Set fso = New Scripting.FileSystemObject

	' 拡張子リスト：複数ある場合は「,」で区切る
	exp_list = "doc,docx"

	' ファイルを検索
	FindFileListExp fso, path, exp_list
End Sub

' ------------------------------------------------------------
' 説明：ファイルを検索します
' 引数：1:FileSystemObject の Object
'       2:ファイルパス
'       3:拡張子リスト
' 補足：サブフォルダも検索します
'       拡張子リストが複数ある場合は「,」で区切ります。
'       例：bmp,png,jpg
' ------------------------------------------------------------
Sub FindFileListExp(fso As Scripting.FileSystemObject, parent_path As Variant, _
			exp_list As String)
	Dim path As Variant
	Dim exp As Variant
	Dim num As Variant
	Dim expwk As Variant
	Dim expname As String

	' フォルダ内のサブフォルダを検索
	For Each path In fso.GetFolder(parent_path).SubFolders

		'Debug.Print path

		Call FindFileListExp(fso, path, exp_list)       ' 再帰検索
	Next

	' 拡張子を分離(,区切りを分割して、配列にコピー)
	If exp_list <> "" Then
		exp = Split(exp_list, ",")	' 分離
		num = UBound(exp) + 1		' 件数を取得
	Else
		num = 0
	End If

	' フォルダ内のファイルを検索
	For Each path In fso.GetFolder(parent_path).Files
		' 検索されたファイルから拡張子を取得
		expname = fso.GetExtensionName(path)
		If num = 0 Then
			' ここに処理を入れます
			Debug.Print path
		Else
			' 拡張子を確認します
			For Each expwk In exp
				If expwk = expname Then
					' ここに処理を入れます
					Debug.Print path

					Exit For
				End If
			Next
		End If
	Next
End Sub

---

4. フォルダ検索した結果を別のエクセルに出力します。 (サブフォルダを検索します)

Sub GetFileListToExcel(path As String)
	Dim exp_list As String
	Dim wb As Workbook
	Dim ws As Worksheet

	Dim fso As Scripting.FileSystemObject
	Set fso = New Scripting.FileSystemObject

	' 拡張子リスト：複数ある場合は「,」で区切る
	exp_list = "doc,docx"

	Set wb = Workbooks.Add		' ブックを作成
	Set ws = wb.Worksheets(1)	' Sheet1を取得

	FindFileListToExcel fso, path, exp_list, ws
End Sub

' ------------------------------------------------------------
' 説明：ファイルを検索します
' 引数：1:FileSystemObject の Object
'       2:ファイルパス
'       3:拡張子リスト
'       4:出力先の worksheet
' 補足：サブフォルダも検索します
'       拡張子リストが複数ある場合は「,」で区切ります。
'       例：bmp,png,jpg
' ------------------------------------------------------------

Sub FindFileListToExcel(fso As Scripting.FileSystemObject, parent_path As Variant, _
			exp_list As String, ws As Worksheet)

	Dim path As Variant
	Dim exp As Variant
	Dim num As Variant
	Dim wk As Variant
	Dim expname As String

	' フォルダ内のサブフォルダを検索
	For Each path In fso.GetFolder(parent_path).SubFolders
		'Debug.Print path
		Call FindFileListToExcel(fso, path, exp_list, ws)      ' 再帰検索
	Next

	' 拡張子を分離
	If exp_list <> "" Then
		exp = Split(exp_list, ",")	' 分離
		num = UBound(exp) + 1		' 件数を取得
	Else
		num = 0
	End If

	' フォルダ内のファイルを検索
	For Each path In fso.GetFolder(parent_path).Files
		expname = fso.GetExtensionName(path)
		If num = 0 Then
			' Excel に出力します
			SetFilename path, ws
		Else
			For Each wk In exp
				If wk = expname Then
					' Excel に出力します
					SetFilename path, ws
					Exit For
				End If
			Next
		End If
	Next
End Sub

' Excel に出力（末尾）
Sub SetFilename(path As Variant, ws As Worksheet)
	Dim row As Long

	' 最終位置の取得
	row = GetBlankRow(ws)

	If row = 0 Then
		' 何もないときは1行目にタイトルを追加して、2行目から入力
		ws.Cells(1, 1) = "Path"		' タイトル
		ws.Cells(2, 1) = path
	Else
		ws.Cells(row + 1, 1) = path
	End If
End Sub

---

【補足】

Scripting.FileSystemObject を使用しています。
初期設定では、エラーが発生するので、参照設定「Microsoft Scripting Runtime」の設定が必要です。