ExcelVBA | Dir関数でサブフォルダを含めたファイル値の取得

別の記事(Excel VBA Dir関数を使用したファイルの取得)でも紹介しているDir関数を使用してフォルダ直下のファイルを抜き出すVBAの、サブフォルダを含めたファイル一覧の値の取得。

サブフォルダ含めた繰り返し処理は少々複雑。デバッグのステップ実行でひとつひとつ追いながら確認していくと内容がよく理解できると思う。時間かけてやっと作ることができた。

 

 


Dirでサブフォルダごとファイルを取得するVBA

 

Dim FSO
Dim i As Long ‘ 総数の変数
Dim FLcnt As Long ‘ ファイル数
Dim FLDcnt As Long ‘ フォルダ数
下記の記載は上記変数宣言の場合に沿う。

Sub Sample_nao()

Dim FSO
Dim i As Long ‘ 総数の変数
Dim FLcnt As Long ‘ ファイル数
Dim FLDcnt As Long ‘ フォルダ数
Dim StartPath As String
Dim FLDS, FLD
StartPath = SelectFolder() ‘ フォルダ選択関数で指定したフォルダ
If StartPath = “” Then Exit Sub
Range(“任意のセル”).Value = Dir(StartPath, vbDirectory)
Set FSO = CreateObject(“Scripting.FileSystemObject”)
i = 1 ‘任意のセルの行番号指定※(このコードの場合)行の変数と考えててOK
Listing (StartPath) ‘ Listingを呼び出し→ここからSub Listing(Fldpath)へ
If FLcnt + FLDcnt < 30 Then
MsgBox “全部で” & ” ” & FLcnt & ” ” & “個のファイル” & vbCrLf & _
FLDcnt & ” ” & “個のフォルダが見つかりました”
Else: MsgBox “全部で30個以上のファイルが見つかりました”
End If
i = 0 ‘ 0に戻しておく
FLcnt = 0 ‘ 0に戻しておく
FLDcnt = 0 ‘ 0に戻しておく
End Sub

Sub Listing(Fldpath)
Dim Fold, Folds, Fl, Fls, n
Set Fls = FSO.GetFolder(Fldpath).Files

以下ファイルの取得
For Each Fl In Fls ‘ ForとNextで繰り返し
If FLcnt + FLDcnt < 30 Then ‘ フォルダとファイル総数が30未満
i = i + 1 FLcnt = FLcnt + 1 Cells(i, “任意のセルを列数で指定”) = Fl.Name ’ 例1. Cells(i, 5)でiの変数が2の場合”B5″のセルにファイル名(Fl.Name)例2. Cells(i, 1)でiの変数が3の場合”C1″のセルにファイル名(Fl.Name)
Cells(i, “任意のセルを列数で指定”) = Fl.Path Else Exit For End If Next Set Folds = FSO.GetFolder(Fldpath).subfolders ‘ 以下サブフォルダの取得
For Each Fold In Folds If FLcnt + FLDcnt > 29 Then Exit For ’ フォルダとファイル総数が30以上の場合は処理を停止※特にここでElseいらないのでこの表記で
i = i + 1
FLDcnt = FLDcnt + 1
Cells(i, “任意のセルを列数で指定”) = “[” & Dir(Fold, vbDirectory) & “]”

上のVBAで実行するとシートには

[ サブフォルダ名 ]
ファイル名
ファイル名
ファイル名

というような形となる。サブフォルダ名だけでよかったのでこのようにしてるが、Pathを表示させたい場合等はDir関数を使用せずに “[” & Fl.Path & “]” 等で応用することができる。

Listing (Fold.Path) ‘ 再帰処理(自分自身Listingを呼び出す)
Next
End Sub

以上、説明終わり。

コピペ用サンプルコードは下記。

 

 


コピペ用サンプルコード

 

Dim FSO
Dim i As Long
Dim FLcnt As Long
Dim FLDcnt As Long

Sub Sample_nao()
Dim StartPath As String
Dim FLDS, FLD
StartPath = SelectFolder()
If StartPath = “” Then Exit Sub
Range(“任意のセル”).Value = Dir(StartPath, vbDirectory)
Set FSO = CreateObject(“Scripting.FileSystemObject”)
i = “任意の値”
Listing (StartPath)
If FLcnt + FLDcnt < 30 Then
MsgBox “全部で” & ” ” & FLcnt & ” ” & “個のファイル” & vbCrLf & _
FLDcnt & ” ” & “個のフォルダが見つかりました”
Else: MsgBox “全部で30個以上のファイルが見つかりました”
End If
i = 0
FLcnt = 0
FLDcnt = 0
End Sub

Sub Listing(Fldpath)
Dim Fold, Folds, Fl, Fls, n
Set Fls = FSO.GetFolder(Fldpath).Files
For Each Fl In Fls
If FLcnt + FLDcnt < 30 Then i = i + 1 FLcnt = FLcnt + 1
Cells(i, “任意のセルを列数で指定“) = Fl.Name
Cells(i, “任意のセルを列数で指定“) = Fl.Path
Else Exit For End If Next Set Folds = FSO.GetFolder(Fldpath).subfolders For Each Fold In Folds If FLcnt + FLDcnt > 29 Then Exit For
i = i + 1
FLDcnt = FLDcnt + 1
Cells(i, “任意のセルを列数で指定“) = “[” & Dir(Fold, vbDirectory) & “]”
Listing (Fold.Path)
Next
End Sub

‘ フォルダ選択関数
Function SelectFolder() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
SelectFolder = .SelectedItems(1)
End With
End Function