この記事では、サブフォルダ含めて全てのフォルダ名とファイル名を取得してシートに書き出す方法についてご説明します。
【動画】サブフォルダ含めて全てのフォルダ名とファイル名を取得してシートに書き出す実際の動き
本題に入る前に、まずは次のツイートをご覧ください。
ディレクトリ配下全てのフォルダ名とファイル名を取得してシートに書き出すマクロを前に作成しましたが、バッチファイルではなくコマンドプロンプトでいいのでは？ということで、マクロを作り直してみました😅
コマンドプロンプトではdirコマンドを呼び出しています😊#ExcelVBA#コマンドプロンプト https://t.co/0En4tiLKSw pic.twitter.com/mHppDOVt8k
— まさ@Excel、VBA、マクロ（経験年数16年） (@masamasa9785) September 22, 2021
シート「TOP」のB2セルに入手されたパスに対して、サブフォルダ含めて全てのフォルダ名とファイル名を取得してシート「data1」「data2」に書き出しています。
※シートの行数を超えるフォルダ名とファイル名が存在する場合は、都度シートを追加してフォルダ名とファイル名を書き出しています。
サブフォルダ含めて全てのフォルダ名とファイル名を取得してシートに書き出す方法
サブフォルダ含めて全てのフォルダ名とファイル名を取得してシートに書き出すには、次の流れの通りにコードを書いていきます。
Excelのマクロ
なお、書き出せるのは1行ずつです。(1度にまとめて複数行(または全行)書き出すことはできません)
コードの例
Excelのマクロのコード(例)
Dim buf As String '一時的な値の格納先変数
Dim wkAry() As String '一時的な値の格納先配列
Dim getPath As String 'サブフォルダ含めて全てのフォルダ名とファイル名を取得したいパス
Dim cmdTxt As String 'コマンドプロンプトのコード用変数
Dim cnt As Integer 'カウンタ(作業用)
Dim shtNMCnt As Integer 'シート名用カウンタ
Dim rPos_cnt As Long 'シートの行位置用カウンタ
Dim ws As Worksheet 'Worksheet用変数
Dim fldrFileNMExptTxt As String 'フォルダ名とファイル名を出力させるCSVファイル名
Dim st As ADODB.Stream 'バイナリ データまたはテキストのストリームのインスタンス用変数
Dim wshObj As WshShell 'WshShellオブジェクト
Dim fso As FileSystemObject 'FileSystemObjectのインスタンス用変数
'Excelの行数
Const rowMAXNum As Long = 1048576
'フォルダ名とファイル名を出力させるCSVファイル名を取得する
fldrFileNMExptTxt = data.csv"
'シートの行位置用カウンタの初期値を設定
rPos_cnt = 2
'シート名用カウンタの初期値を設定
shtNMCnt = 0
'サブフォルダ含めて全てのフォルダ名・ファイル名を取得したいパス
getPath = "c:\work"
'バイナリ データまたはテキストのストリームのインスタンスを生成する
Set st = New ADODB.Stream
'FileSystemObjectのインスタンスを生成する
Set fso = New FileSystemObject
'WshShellオブジェクトからインスタンスを生成する
Set wshObj = New WshShell
If Right(getPath, 1) <> "\" Then
'入力されたパスの末尾に「\」が付いていない場合に付ける
getPath = getPath & "\"
End If
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & """" & " > " & ActiveWorkbook.Path & "\" & fldrFileNMExptTxt & ""
'コマンドプロンプトで変数「cmdTxt」のコマンドを実行する
Call wshObj.Run("%ComSpec% /c " & cmdTxt, 1, WaitOnReturn:=True)
'フォルダ名とファイル名貼り付け用シート有無のチェック
For Each ws In Worksheets
If ws.Name = "data" & CStr(shtNMCnt + 1) Then
'フォルダ名とファイル名貼り付け用シートが存在する場合
'確認ダイアログを非表示にする
Application.DisplayAlerts = False
'フォルダ名とファイル名貼り付け用シートを選択する
Sheets("data" & CStr(shtNMCnt + 1)).Select
'フォルダ名とファイル名貼り付け用シートを削除する
ActiveWindow.SelectedSheets.Delete
'確認ダイアログを表示可にする
Application.DisplayAlerts = True
shtNMCnt = shtNMCnt + 1
End If
Next ws
'シート名用カウンタを0に初期化する
shtNMCnt = 0
'フォルダ名・ファイル名を列挙するためのシートを新規作成する
Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
.Name = "data" & CStr(shtNMCnt + 1)
With Sheets("data" & CStr(shtNMCnt + 1))
'1行目に項目を設定する
.Range("A1").Value = "パス"
.Range("B1").Value = "フォルダ名／ファイル名"
'A列に色を付ける
.Range("A1:B1").Interior.Color = RGB(252, 228, 214)
'B列を「文字列」に設定する
.Columns("B").NumberFormatLocal = "@"
End With
With st
.Charset = "UTF-8" '文字セットにUTF-8を設定する
.Open 'streamを開く
.LoadFromFile ActiveWorkbook.Path & "\" & _
fldrFileNMExptTxt 'フォルダ名とファイル名が出力されたファイルから読み込む
'Streamの末尾まで繰り返す
Do Until .EOS
'取り出したテキストを変数「buf」に格納する
buf = .ReadText(adReadLine)
'フルパスから「\」を区切り文字としてフォルダ名・ファイル名を配列に格納する
wkAry = Split(buf, "\")
'フルパスからパスを切り出してA列に設定する
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 1).Value = Left(buf, Len(buf) - Len(wkAry(UBound(wkAry))))
'フルパスからフォルダ名またはファイル名を切り出してB列に設定する
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 2).Value = wkAry(UBound(wkAry))
'フルパスがフォルダなのかファイルなのかを判定する(True：ファイル／False：フォルダ)
If fso.FileExists(buf) Then
'ファイルの場合
'B列のセルに色を付ける(※本マクロではファイルの場合は黄色を付けるようにしています)
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 2).Interior.Color = RGB(255, 255, 200)
Else
'フォルダの場合
'B列のセルに色を付ける(※本マクロではフォルダの場合は緑色を付けるようにしています)
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 2).Interior.Color = RGB(198, 224, 180)
End If
rPos_cnt = rPos_cnt + 1
'Excelの行数を超える場合
If (rPos_cnt Mod rowMAXNum) = 0 Then
shtNMCnt = shtNMCnt + 1
'(Excelの行数を超えるので)フォルダ名・ファイル名を列挙するためのシートを新規作成する
Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
.Name = "data" & CStr(shtNMCnt + 1)
With Sheets("data" & CStr(shtNMCnt + 1))
'1行目に項目を設定する
.Range("A1").Value = "パス"
.Range("B1").Value = "フォルダ名／ファイル名"
'A1とB1のセルに色を付ける
.Range("A1:B1").Interior.Color = RGB(252, 228, 214)
'B列を「文字列」に設定する
.Columns("B").NumberFormatLocal = "@"
End With
'シートの行位置用カウンタの初期値を設定(シートを追加したのでまた2行目からカウントする)
rPos_cnt = 2
End If
DoEvents
Loop
'Streamの末尾まで処理が終わったので、streamを閉じる
.Close
End With
For cnt = 0 To shtNMCnt
With Sheets("data" & CStr(cnt + 1))
'セルの幅を自動調整する
.Cells.EntireColumn.AutoFit
If cnt = shtNMCnt Then
'A列に色を付ける
.Range("A2:A" & rPos_cnt - 1).Interior.Color = RGB(232, 236, 239)
'セルに罫線を引く
.Range("A1:B" & rPos_cnt - 1).Borders.LineStyle = xlContinuous
Else
'A列に色を付ける
.Range("A2:A" & rowMAXNum - 1).Interior.Color = RGB(232, 236, 239)
'セルに罫線を引く
.Range("A1:B" & rowMAXNum - 1).Borders.LineStyle = xlContinuous
End If
End With
Next
'後処理
'フォルダ名とファイル名が出力されたファイルを削除する
Call fso.DeleteFile(ActiveWorkbook.Path & "\" & fldrFileNMExptTxt, True)
Set st = Nothing
Set fso = Nothing
コードの解説
注目すべきコード①
最初に見て頂きたいのは46行目から49行目です。
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & """" & " > " & ActiveWorkbook.Path & "\" & fldrFileNMExptTxt
'コマンドプロンプトで変数「cmdTxt」のコマンドを実行する
Call wshObj.Run("%ComSpec% /c " & cmdTxt, 1, WaitOnReturn:=True)
46行目でコマンドプロンプトでdirコマンドを実行するためのコマンド文を変数に格納し、そのコマンド文を49行目でRunメソッドの引数に設定してコマンドプロンプトでdirコマンドを実行しています。
なぜわざわざコマンドプロンプトを使っているのか(呼び出しているのか)というと、処理の高速化を図るためです。
大量のフォルダやファイルが存在する場合に、マクロだけでやろうとすると時間がかかりすぎるために高速化が実現できるコマンドプロンプトを使っています。
(※絶対にコマンドプロンプトを使わなければいけないというわけではありませんが、今回は手軽に使うことができるコマンドプロンプトを採用しました)
例えば、私のパソコンのCドライブ配下にはサブフォルダ含めて全てのフォルダとファイルの数はファイル数が110万超、フォルダー数が250万近くありますが、これほどの数をExcelマクロだけでシートに書き出そうとすると何時間もかかってしまいます。
これだけの大量にあるフォルダとファイルを取得してシートに書き出したい場合に、マクロだけで行うのは処理時間を考えると現実的ではないです。
一方、コマンドプロンプトを呼び出してdirコマンドを使い(Cドライブ配下の)、ファイル名とサブディレクトリ名を一覧出力すると(私のパソコンでは)20分弱で終わりました。(完了するまでの時間はPCのスペックに左右されますが)
話を戻しますが、46行のコードではどんなコマンド文が呼び出されるのか分かりにくいのでサンプルをお見せします。
chcp 65001 | dir /b /s "C:\" > C:\work\data.csv
このコマンド文は1行ですが、実は2つのコマンドを1行で実行しています。
2つのコマンドは次の通りです。
①chcp 65001
②dir /b /s “C:\” > C:\work\data.csv
- ①のコマンドは、文字コードをUTF-8に設定するコマンドで、文字化けしないように文字コードをUTF-8に設定しています。
(文字コードをUTF-8に設定すると文字化けしない) - ②のコマンドは、dirコマンドを実行してファイル「data.csv」にディレクトリにあるファイルとサブディレクトリの一覧出力しています。
以上、上記のコマンドが実行されると、フォルダ名とファイル名が出力された「data.csv」というファイルが出力されます。
この「data.csv」をExcelマクロが読み込んでシートにフォルダ名とファイル名をセルに書き出していきます。
ちなみに、フォルダ名とファイル名を全てセルに書き出したら、必要がなくなるので206行目で削除します。
'フォルダ名とファイル名が出力されたファイルを削除する
Call fso.DeleteFile(ActiveWorkbook.Path & "\" & fldrFileNMExptTxt, True)
注目すべきコード②
次に見て頂きたいのは81行目から103行目です。
With st
.Charset = "UTF-8" '文字セットにUTF-8を設定する
.Open 'streamを開く
.LoadFromFile ActiveWorkbook.Path & "\" & _
fldrFileNMExptTxt 'フォルダ名とファイル名が出力されたファイルから読み込む
'Streamの末尾まで繰り返す
Do Until .EOS
'取り出したテキストを変数「buf」に格納する
buf = .ReadText(adReadLine)
'フルパスから「\」を区切り文字としてフォルダ名・ファイル名を配列に格納する
wkAry = Split(buf, "\")
'フルパスからパスを切り出してA列に設定する
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 1).Value = Left(buf, Len(buf) - Len(wkAry(UBound(wkAry))))
'フルパスからフォルダ名またはファイル名を切り出してB列に設定する
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 2).Value = wkAry(UBound(wkAry))
83行目で、文字コードをUTF-8に設定してフォルダ名とファイル名が出力された「data.csv」をExcelマクロが読み込むためにCharsetプロパティに「UTF-8」の文字列を設定しています。
次に84行目でOpenメソッドを実行し、85行目のLoadFromFile メソッドの引数に「data.csv」を設定して「data.csv」を読み込みます。
89行目のDoループで、読み込んだ「data.csv」の行数分処理を繰り返します。
92行目では、1行取り出して変数「buf」に格納しています。この1行はフルパスになります。
取り出した1行(フルパス)から「\」を区切り文字としてフォルダ名・ファイル名を配列「wkAry」に格納し、フルパスからパスとフォルダ名またはファイル名を取り出します。
パスは98行目でA列のセルに、フォルダ名またはファイル名は101行目でB列のセルに設定します。
注目すべきコード③
次に見て頂きたいのは138行目から144行目です。
'Excelの行数を超える場合
If (rPos_cnt Mod rowMAXNum) = 0 Then
shtNMCnt = shtNMCnt + 1
'(Excelの行数を超えるので)フォルダ名・ファイル名を列挙するためのシートを新規作成する
Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
.Name = "data" & CStr(shtNMCnt + 1)
フォルダとファイルの数がExcelの最大行数を超える場合は、新たにシートを追加します。
最大行数を超えるかを138行目で判定し、もし超える場合は143行目で新たにシートを作成します。
注目すべきコード④
次に見て頂きたいのは27行目です。
'サブフォルダ含めて全てのフォルダ名・ファイル名を取得したいパス
getPath = "c:\work"
27行目で、サブフォルダ含めて全てのフォルダ名とファイル名を取得するパスを指定しています。
サブフォルダ含めて全てのフォルダ名とファイル名を取得してシートに書き出した結果
本マクロを実行すると、サブフォルダ含めて全てのフォルダ名とファイル名を取得してシートに書き出されます。
【注意】参照設定が必要です
一つ注意点があるのですが、先ほどのコードを動かすには参照設定が必要です。
参照設定の一覧(下の画像を参考)から次の項目(ライブラリ)にチェックを付けて「OK」ボタンをクリックします。
- Microsoft ActiveX Data Objects 2.8 Library(msado28.tlb)
- Windows Script Host Object Model(wshom.ocx)
なぜ必要かというと、先ほどのコードの10行目の「ADODB.Stream」というオブジェクトが「msado28.tlb」というファイルを、11行目の「WshShell」と12行目の「FileSystemObject」というオブジェクトが「wshom.ocx」というファイルを参照するからです。
Dim st As ADODB.Stream 'バイナリ データまたはテキストのストリームのインスタンス用変数
Dim wshObj As WshShell 'WshShellオブジェクト
Dim fso As FileSystemObject 'FileSystemObjectのインスタンス用変数
この参照設定をしないと下の画像のエラーが出ますので必ず行う必要があります。
ここでは「msado28.tlb」と「wshom.ocx」とは何者かについては記事の本題から逸れてしまうので詳細は割愛しますが、マクロで「ADODB.Stream」「WshShell」「FileSystemObject」というオブジェクトを使う場合は参照設定しないと動かない、程度に思って頂ければと思います。
最後に
本記事では、サブフォルダ含めて全てのフォルダ名とファイル名を取得してシートに書き出す方法についてご説明しました。
サブフォルダ含めて全てのフォルダ名とファイル名を取得したい場合は参考にしてみてくださいね。
プログラミングのスキルを習得するなら
プログラミングのスキルを習得したい、今のスキルをもっと高めたい、そう考えているなら「プログラミングスクール」がおすすめです。
プログラミングのスキルの基礎を身につけるなら「TechAcademy」で1週間の無料体験があるので、これで「プログラミングの基礎」を学ぶのにおすすめですよ。
