Sub ダイアログからサブフォルダ含むファイル数を取得()
Dim intIchi As Integer
Dim strFolderpass As String
Dim objFileDialog As Object
'ファイル名一覧を出力する行番号を指定します。
intIchi = 2
'指定範囲の値をクリアします。
Range("A2:B1000000").Clear
'ファイルダイアログオブジェクトをフォルダ選択モードでオブジェクトに設定します。
Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
'ダイアログボックスを表示させます。
If objFileDialog.Show = True Then
'ダイアログで選択したフォルダのパスをSelectedItemsプロパティ（1番目のインデックス値）から取得し代入します。
strFolderpass = objFileDialog.SelectedItems(1)
'ファイル名取得プロシージャを呼び出します。
Call ファイル数取得プロシージャ(strFolderpass, intIchi)
Else
'「キャンセル」ボタンが押された場合メッセージを表示させます。
MsgBox "フォルダの選択をキャンセルしました。"
End If
Set objFileDialog = Nothing
End Sub
Sub ファイル数取得プロシージャ(strFolderpass As String, intIchi As Integer)
Dim objfFSO As Object
Dim objFiles As Object
Dim objFile As Object
Dim objSubFolders As Object
Dim objSubFolder As Object
'対象フォルダのパスの値があれば処理をおこないます。
If strFolderpass = "" Then
MsgBox "対象フォルダのパスがありません。パスを入力してください。"
Else
'FileSystemObjectはファイルやフォルダを操作する専用のオブジェクトです｡インスタンスにセットします。
Set objfFSO = CreateObject("Scripting.FileSystemObject")
'対象フォルダのファイルオブジェクトをセットします。
Set objFiles = objfFSO.GetFolder(strFolderpass).Files
'1階層目のフォルダパスとファイル数を出力します。
Cells(intIchi, 1) = strFolderpass
Cells(intIchi, 2) = objFiles.Count
intIchi = intIchi + 1
'対象フォルダのサブフォルダファイルオブジェクトをセットします。
Set objSubFolders = objfFSO.GetFolder(strFolderpass).SubFolders
'サブフォルダを含むファイル数取得の処理をおこないます。
For Each objSubFolder In objSubFolders
If objSubFolder.Path <> "" Then
'サブフォルダのパスを本プロシージャへ渡して再帰的に処理を繰り返します。
Call ファイル数取得プロシージャ(objSubFolder.Path, intIchi)
End If
Next objSubFolder
End If
Set objfFSO = Nothing
Set objFiles = Nothing
Set objFile = Nothing
Set objSubFolders = Nothing
Set objSubFolder = Nothing
End Sub
コメントを残す