ファイルのリストアップ再帰呼び出しを使用したファイルのリストアップ
プログラムのある関数が、自分自身の関数を呼び出す「再帰」。その再帰呼び出しを利用して、任意のフォルダのサブフォルダ、ファイルをリストアップするコードとメモです。
ポイント
・FileDiarogプロパティ
・フォルダの存在確認
・再帰呼び出し
・FileSystemObject
FileDialogプロパティの引数に「msoFileDialogFolderPicker」を設定しコードを実行すると、「参照」のダイアログが表示される。ダイアログではフォルダを選択でき、選択したフォルダは、SelectedItemsプロパティで、そのパスを取得できる。
何らかの理由で、フォルダの存在を確認するケースも考えられるので、Dir関数を用いたフォルダの存在確認方法を、補足として併記する。
再帰呼び出しは、ある計算結果に対して同じ処理を連続して行う場合に使うことが多い。コードが簡素化される利点もあるが、処理から抜ける条件が成り立たず、無限ループに陥ることがあるため、気をつけなければならない。
今回、再帰呼び出しのサンプルとしてファイルをリストアップする。尚、処理を抜ける条件は「任意のフォルダにサブフォルダが存在しない」である。
再帰呼び出し中での、フォルダ、ファイルの操作にはFileSystemObjectを使用した。
このコードを利用したソフトはこちら「ファイルリストアップ」
処理の中断、重複ファイルの確認等の処理を追加している。
Excelマクロ管理ツール
サンプルコード
再帰呼び出しを利用したファイルのリストアップ。リストアップしたデータは新規ブックに書き込まれる。
Private lngUsedRow As Long, lngUsedCol As Long 'データ書込に使用するセル範囲カウント用 Private lngDireCount As Long, lngFileCount As Long 'フォルダ、ファイル数格納用 Private strDP As String, strSep As String Private varArea As Variant Private strDirName(1 To 3) As String
Sub Main_Sub() With Application.FileDialog(msoFileDialogFolderPicker) strDP = "" If .Show = True Then strDP = .SelectedItems(1) 'フォルダ選択 If strDP = "" Then Exit Sub End With If File_ListUp Then 'サーチ MsgBox "フォルダ数:" & lngDireCount & vbCrLf & _ "ファイル数:" & lngFileCount, _ vbOKOnly + vbInformation, "処理完了" End If strDP = Dir("") End Sub
Private Function File_ListUp() As Boolean Dim lngSep As Long, lngSC As Long Dim strDN As String 'フォルダ名格納用 With Application strSep = .PathSeparator 'パスセパレーターの取得 lngSep = InStrRev(strDP, strSep) If lngSep = 0 Then GoSub FIN_1 If strSep = Right$(strDP, 1) Then strDP = Left$(strDP, Len(strDP) - 1) On Error GoTo FIN_1 strDN = Dir(strDP, vbDirectory) 'フォルダの存在確認 On Error GoTo 0 If strDN = "" Then GoSub FIN_1 If InStr(strDP, strSep) = 0 Then strDN = "" lngDireCount = 1 lngFileCount = 0 Call Count_Dir_File(1, 2, Left$(strDP, lngSep), strDN & strSep) lngSC = .SheetsInNewWorkbook .SheetsInNewWorkbook = 1 'シート数を1枚に設定 .Workbooks.Add '新しいブックの挿入 .SheetsInNewWorkbook = lngSC With .ActiveWorkbook.Worksheets(1) If .Rows.Count < lngUsedRow Or .Columns.Count < lngUsedCol Then GoSub FIN_2 If lngUsedRow = 0 Then lngUsedRow = 1 If lngUsedCol < 2 Then lngUsedCol = 2 With .Range(.Cells(1, 1), .Cells(lngUsedRow, lngUsedCol)) varArea = .Value strDirName(1) = "[" strDirName(3) = "]" If strDN = "" Then strDirName(2) = strDP Else strDirName(2) = strDN varArea(1, 1) = Join$(strDirName) Call ListUp_Main(2, 2, Left$(strDP, lngSep), strDN & strSep) .Value = varArea '書き込み End With .UsedRange.EntireColumn.ColumnWidth = 4.38 Erase varArea End With End With File_ListUp = True Exit Function FIN_1: MsgBox "選択したフォルダは対象外です", vbOKOnly + vbExclamation, "中止します" Exit Function FIN_2: MsgBox "シートに表示しきれません", vbOKOnly + vbExclamation, "中止します" End Function
'フォルダ、ファイル数のカウント用プロシージャ(再帰) Private Sub Count_Dir_File(ByRef r As Long, ByRef c As Long, _ ByVal strDirPath As String, ByVal strNewDir As String) Dim F As Object, FSO As Object, objDirectory As Object On Error GoTo ERR Set FSO = CreateObject("Scripting.FileSystemObject") Set objDirectory = FSO.GetFolder(strDirPath & strNewDir) With objDirectory lngDireCount = lngDireCount + .SubFolders.Count If 0 < .SubFolders.Count Then 'サブフォルダの有無確認 For Each F In .SubFolders c = c + 1 r = r + 1 If lngUsedCol < c Then lngUsedCol = c Call Count_Dir_File(r, c, strDirPath & strNewDir, F.Name & strSep) c = c - 1 Next End If lngFileCount = lngFileCount + .Files.Count 'ファイル数取得 r = r + .Files.Count lngUsedRow = r End With On Error GoTo 0 ERR: Set objDirectory = Nothing Set FSO = Nothing End Sub
'フォルダ、ファイル名を変数に格納するプロシージャ(再帰) Private Sub ListUp_Main(ByRef r As Long, ByRef c As Long, _ ByVal strDirPath As String, ByVal strNewDir As String) Dim F As Object, FSO As Object, objDirectory As Object On Error GoTo ERR Set FSO = CreateObject("Scripting.FileSystemObject") Set objDirectory = FSO.GetFolder(strDirPath & strNewDir) With objDirectory If 0 < .SubFolders.Count Then For Each F In .SubFolders strDirName(2) = F.Name 'フォルダ名取得 varArea(r, c) = Join$(strDirName) c = c + 1 r = r + 1 Call ListUp_Main(r, c, strDirPath & strNewDir, F.Name & strSep) c = c - 1 Next End If If 0 < .Files.Count Then For Each F In .Files varArea(r, c) = F.Name 'ファイル名の取得と代入 r = r + 1 Next End If End With On Error GoTo 0 ERR: Set objDirectory = Nothing Set FSO = Nothing End Sub
※サンプルコードがエラーで中断される場合
・VBEのオプション設定を変更 参照
・プロジェクトをロックする 参照
メモ
再帰呼び出しサブルーチンListUp_Mainプロシージャの流れ
[1] FileSystemObjectのインスタンスを作成
[2] 与えられたパスのフォルダオブジェクトを作成
[3] 該当フォルダオブジェクトのサブフォルダ数を確認
サブフォルダ在り:サブフォルダのパスを自身(ListUp_Mainプロシージャ)に設定し[ 1 ]へ
サブフォルダなし:[ 4 ]へ
[4] 該当フォルダオブジェクトのファイル数を確認
ファイル在り:ファイル名を取得後[ 5 ]へ
ファイルなし:[ 5 ]へ
[5] フォルダオブジェクト、FileSystemObjectのインスタンスを破棄
[6] この階層のListUp_Mainプロシージャを抜ける
「$」の付く関数
Join関数
InstrRev関数
FileDiarogプロパティ
ファイルダイアログを表示する。引数により表示されるダイアログの種類が異なる。引数に設定できるのは、次のMsoFileDialogTypeクラスの定数のいずれか。
・msoFileDialogFilePicker 「参照」ダイアログでファイルを選択できます。
・msoFileDialogFolderPicker 「参照」ダイアログでフォルダを選択できます。
・msoFileDialogOpen 「ファイルを開く」ダイアログ
・msoFileDialogSaveAs 「名前をつけて保存」ダイアログ
ファイルダイアログは、ファイル(フォルダ)のパスを取得するものであり、「ファイルを開く」や「名前をつけて保存」のダイアログであっても、実際にファイルが開かれたり、保存されるものではない。
ダイアログで選択したファイル(フォルダ)パスの取得には、SelectedItemsプロパティを使用する。使用例は以下を参照。
Sub UseFileDialogOpen() Dim lngCount As Long ' ファイル ダイアログを開きます。 With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True 'ファイルの複数選択を可能にする .Show ' 選択された各ファイルのパスを表示します。 For lngCount = 1 To .SelectedItems.Count MsgBox .SelectedItems(lngCount) Next lngCount End With End Sub
Dir関数
指定したパターンやファイル属性に一致する、ファイルやフォルダの名前の文字列を返す。返される文字列は(String型)。ドライブのボリュームラベルも取得可能。
構文:Dir[(pathname[, attributes])]
[pathname]
ファイル名を表す文字列式を指定。フォルダ名やドライブ名も含めて指定可能。
指定した内容が見つからないときは、長さ「0」の文字列を返す。
[attributes]
省略可能です。取得したいファイルの属性の値の合計、または定数を指定。
省略すると、標準ファイルの属性。Windowsでの「設定値」は以下の6つ
【定数 / 値 / 内容】
vbNormal / 0 / 標準ファイル
vbReadOnly / 1 / 読み取り専用ファイル
vbHidden / 2 / 隠しファイル
vbSystem / 4 / システム ファイル
vbVolume / 8 / ボリューム ラベル。この値を指定すると、すべての属性は無効。
vbDirectory / 16 / フォルダ
FileSystemObject
後日記載。