FileSystemObjectを使用して指定したフォルダのサブフォルダも含めて保存されている全てのファイルのファイル名を取得してExcelのセルに書き出すVBAのサンプルプログラムを覚書。
Office 2007以降はFileSearchオブジェクトが使用できなくなったため、代わりに"FileSystemObject"を再帰呼び出しする方法を使います。
元になった記事
Excelで使う時のが多いかなと思って以前書いたAccessのVBAの記事のサンプルプログラムをExcel VBAに書きなおしました。
サンプルプログラム概要
この記事では3つのサンプルプログラムを紹介します。
- 取得したファイル名の一覧をセルにフルパスで書き出すサンプルプログラム
- 取得したファイル名の一覧をパスとファイル名に分けて2つのセルに書き出すサンプルプログラム
- 取得したファイル名の一覧をパスの区切りである"\"マークを区切り文字として分けてから各セルに書き出すサンプルプログラム
3番めのサンプルプログラムについてですが、例えば"C:\Folder1\SubFolder2\File.txt"というファイルがあった場合、セルには\マークを区切りに"C:","Folder1"、"Folder2"、"File.txt"の4つに分解されて各セルに書き出されます。
取得したファイル名の一覧をセルにフルパスで書き出すサンプルプログラム
以下に指定したフォルダのサブフォルダも含めて保存されているファイル名の一覧を取得してフルパスでセルに書き出すサンプルプログラムを記載します。
再帰呼び出しを行うため、別のプログラムから呼び出して使用する方法になっています。
サンプルプログラム本体
Sub GetFileList01(Search_Path)
Dim objFs As Object, objFiles As Object, objFolders As Object
'処理が遅くなるのでプログラム実行中の画面描画を停止する
Application.ScreenUpdating = False
Set objFs = CreateObject("Scripting.FileSystemObject")
'パスの取得
For Each objFolders In objFs.GetFolder(Search_Path).SubFolders
'サブフォルダまで検索するために再帰実行
GetFileList01 objFolders.Path
Next
'ファイル名の取得
For Each objFiles In objFs.GetFolder(Search_Path).Files
'セルにファイル名を書き込む
ActiveCell.Value = objFiles.Path
ActiveCell.Offset(1, 0).Select
Next
End Sub
実際にサンプルプログラムを動作させる際はこちらを実行します。
Sub Call_GetFileList()
Worksheets("Sheet1").Range("a1").Select
GetFileList01 "C:¥Program Files"
End Sub
上記サンプルでは、例として"C:\Program Files"フォルダを指定しています。
取得したファイル名の一覧をパスとファイル名に分けて2つのセルに書き出すサンプルプログラム
以下にファイル名とパスを別々のセルに書き出すサンプルプログラムを記載します。
同様に実行時は別のプログラムから呼び出して実行します。
サンプルプログラム本体
Sub GetFileList02(Search_Path)
Dim objFs As Object, objFiles As Object, objFolders As Object
Dim File_Path As String, File_Name As String
Dim Start_No As Integer
'処理が遅くなるのでプログラム実行中の画面描画を停止する
Application.ScreenUpdating = False
Set objFs = CreateObject("Scripting.FileSystemObject")
'パスの取得
For Each objFolders In objFs.GetFolder(Search_Path).SubFolders
'サブフォルダまで検索するために再帰実行
GetFileList02 objFolders.Path
Next
'ファイル名の取得
For Each objFiles In objFs.GetFolder(Search_Path).Files
Start_No = InStrRev(objFiles.Path, "¥") + 1
File_Name = Right(objFiles.Path, Len(objFiles.Path) - Start_No)
File_Path = Left(objFiles.Path, Start_No - 1)
'セルにパスとファイル名を書き込む
ActiveCell.Value = File_Path
ActiveCell.Offset(0, 1).Value = File_Name
ActiveCell.Offset(1, 0).Select
Next
End Sub
実際にサンプルプログラムを動作させるプログラム。
Sub Call_GetFileList()
GetFileList02 "C:¥Program Files"
End Sub
取得したファイル名の一覧をパスの区切りである"\"マークを区切り文字として分けてから各セルに書き出すサンプルプログラム
以下にフルパスを"\"マークを区切り文字として分解し、分解された各値を別々のセルに書き出すサンプルプログラムを記載します。
実行時は別のプログラムから呼び出して実行します。
サンプルプログラム本体
Sub GetFileList03(Search_Path)
Dim objFs As Object, objFiles As Object, objFolders As Object
Dim File_Path As String, File_Name As String
Dim i As Long, arrData
'処理が遅くなるのでプログラム実行中の画面描画を停止する
Application.ScreenUpdating = False
Set objFs = CreateObject("Scripting.FileSystemObject")
'パスの取得
For Each objFolders In objFs.GetFolder(Search_Path).SubFolders
'サブフォルダまで検索するために再帰実行
GetFileList03 objFolders.Path
Next
'ファイル名の取得
For Each objFiles In objFs.GetFolder(Search_Path).Files
'¥マークを区切り文字として各文字列を配列に代入
arrData = Split(objFiles.Path, "¥")
'セルに配列の各値を書き込む
For i = 0 To UBound(arrData)
ActiveCell.Offset(0, i).Value = arrData(i)
Next i
ActiveCell.Offset(1, 0).Select
Next
End Sub
実際にサンプルプログラムを動作させるプログラム。
Sub Call_GetFileList()
GetFileList03 "C:¥Program Files"
End Sub
サブフォルダも含めて指定したフォルダのファイル名一覧をセルに書き出しするサンプルプログラムまとめ
別の記事で紹介したAccessのVBAで作ったプログラムをExcelのVBA用にプログラムを書き換えました。
Accessで行う場合はこちらの記事を参照してください。
コメント
> 1つ目、正しい
> 2つ目、拡張子が正しくない
> 3つ目、フォルダ名が正しくない場合あり
>
> 記事にするなら、間違いを掲載しないほうがいい
> 動作チェックをしていますか?
上記の指摘ありがとうございます。
実際に使用しているプログラムなので動作確認はしていますが、修正前のコードを掲載してしまったようです。
正しい方のコードに差し替えました。
3番めの指摘については、”フォルダ名が正しくない場合がある”という状況が発生していないため確認が取れません。
どういうフルパスがどう間違っているのか具体例があればよいのですが…