この記事では、サブフォルダ含めて全フォルダ名を階層ごとにExcelのシートに書き出す方法についてご説明します。
【動画】サブフォルダ含めて全フォルダ名を階層ごとにExcelのシートに書き出す実際の動き
本題に入る前に、まずは次の動画をご覧ください。
まずは指定されたトップディレクトリ配下にあるすべてのフォルダ内の階層構造を再帰的に解析してフォルダ名を取得します。
取得したフォルダを、階層順に1つずつExcelのシートに書き出します。
マクロ作成の流れ
Excelファイルの例
今回は次のExcelファイルを用意しました。
A2の黄色のセルにフォルダのフルパスを入力して実行ボタンをクリックすると、以下のようにシート「data」が生成されてサブフォルダ含めて全フォルダ名を階層ごとに書き出されます。
ちなみに、トップフォルダ配下にあるフォルダ内のファイルは下のとおりです。
コードの例
Option Explicit
Private Sub btn_exec_Click()
Dim fso As Object 'FileSystemObjectのインスタンス用変数
Dim folder As Object 'フォルダ用変数
Dim colPos As Long '行位置用変数
Dim rowPos As Long '列位置用変数
Dim wstop As Worksheet 'ワークシート用変数(シート「top」用)
Dim ws As Worksheet 'ワークシート用変数(作業用)
Dim dirPath As String 'ファイルのパスを格納する変数
Dim shtExistFlg As Boolean 'シート存在確認フラグ
Dim rng As Range 'Rangeオブジェクト格納用変数
Dim cnt As Long 'カウンタ用変数
'フォルダ名を出力するシート名
Const dtSheetNM As String = "data"
'先頭行の位置を取得する
colPos = 1
'先頭列の位置を取得する
rowPos = 2
'本マクロのブックのシート名を取得する
Set wstop = Worksheets("top")
If Right(wstop.Range("dirPath").Value, 1) = "\" Then
'入力された「トップディレクトリ」のパスの末尾に「\」が付いている場合
'「トップディレクトリ」のパスを変数filePathに格納する
dirPath = wstop.Range("dirPath").Value
Else
'入力された「トップディレクトリ」のフルパスの末尾に「\」が付いていない場合
'「トップディレクトリ」のパスの末尾に「\」を付けて、パスを変数filePathに格納する
dirPath = wstop.Range("dirPath").Value & "\"
End If
'FileSystemObjectのインスタンスを生成する
Set fso = CreateObject("Scripting.FileSystemObject")
'GetFolderメソッドを使用して、指定したパスのフォルダを取得する
Set folder = fso.GetFolder(dirPath)
'フォルダ名貼り付け用シート有無のチェック
For Each ws In Worksheets
If ws.Name = dtSheetNM Then
'シート「data」が存在している場合
'変数「shtExistFlg」にTrueを設定する
shtExistFlg = True
End If
Next ws
If shtExistFlg = False Then
'シート「data」が存在しない場合
'テーブルから取得するデータを列挙するためのシートを新規作成する
Worksheets.Add(After:=Worksheets(Worksheets.count)) _
.Name = dtSheetNM
Else
'シート「data」が存在する場合
'シート「data」のセル全てをクリアする
Worksheets(dtSheetNM).Cells.Clear
End If
'本マクロのブックのシート名を取得する
Set ws = Worksheets(dtSheetNM)
If IsNumeric(folder.Name) Then
'フォルダ名が数値の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, colPos).Value = "'" & CStr(folder.Name)
Else
'フォルダ名が数値以外の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, colPos).Value = folder.Name
End If
'フォルダ名を検索するサブルーチンを呼び出す
Call folderSearch(folder, colPos + 1, rowPos + 1, ws)
For cnt = 2 To ws.Columns.count
' 各列に値があるか確認します。
Set rng = ws.Columns(cnt).Find("*", LookIn:=xlValues)
If rng Is Nothing Then
'列に値が無い場合
'ループを抜ける
Exit For
Else
'列に値がある場合
'1行目のセルに「階層n」の文字列を出力する
ws.Cells(1, cnt).Value = "階層" & cnt - 1
End If
Next cnt
'後処理
Set fso = Nothing
Set folder = Nothing
Set wstop = Nothing
Set ws = Nothing
End Sub
Sub folderSearch(folder As Object, colPos As Long, rowPos As Long, ws As Worksheet)
Dim subFolder As Object
Dim cnt As Integer
If folder.SubFolders.count > 0 Then
'フォルダ内にフォルダが存在している場合
'フォルダ内のフォルダの数だけ処理を行うFor文
For Each subFolder In folder.SubFolders
'列の数だけ処理を繰り返すFor文
For cnt = 1 To colPos - 1
If IsNumeric(ws.Cells(rowPos - 1, cnt).Value) Then
'フォルダ名が数値の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, cnt).Value = "'" & CStr(ws.Cells(rowPos - 1, cnt).Value)
Else
'フォルダ名が数値以外の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, cnt).Value = ws.Cells(rowPos - 1, cnt).Value
End If
Next cnt
If IsNumeric(subFolder.Name) Then
'フォルダ名が数値の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, colPos).Value = "'" & CStr(subFolder.Name)
Else
'フォルダ名が数値以外の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, colPos).Value = subFolder.Name
End If
rowPos = rowPos + 1
'パスのサブフォルダを対象にループする
Call folderSearch(subFolder, colPos + 1, rowPos, ws)
DoEvents
Next subFolder
End If
'後処理
Set subFolder = Nothing
End Sub
注目すべきコード①
最初に見て頂きたいのは28行目から42行目です。
If Right(wstop.Range("dirPath").Value, 1) = "\" Then
'入力された「トップディレクトリ」のパスの末尾に「\」が付いている場合
'「トップディレクトリ」のパスを変数filePathに格納する
dirPath = wstop.Range("dirPath").Value
Else
'入力された「トップディレクトリ」のフルパスの末尾に「\」が付いていない場合
'「トップディレクトリ」のパスの末尾に「\」を付けて、パスを変数filePathに格納する
dirPath = wstop.Range("dirPath").Value & "\"
End If
コードの説明
以上のコードは、ファイルの置き場のパスを取得するコードです。
トップフォルダのパスは、A2のセル(dirPathという名前付きセル)に入力されたパスから取得しています。
※A2の黄色のセルには「dirPath」という名前を付けています。
コードの詳細
28行目のコードは、A2セルに入力されたパスの末尾に「¥」の文字が含まれているか判定するIFです。
もし「¥」の文字が含まれている場合は、33行目で変数dirPathにそのままパスを格納します。
「¥」の文字が含まれていない場合は、40行目でパスの末尾に「¥」を付けて変数dirPathに格納します。
注目すべきコード②
次に見て頂きたいのは45行目から48行目です。
'FileSystemObjectのインスタンスを生成する
Set fso = CreateObject("Scripting.FileSystemObject")
'GetFolderメソッドを使用して、指定したパスのフォルダを取得する
Set folder = fso.GetFolder(dirPath)
コードの説明
以上のコードは、FileSystemObjectのインスタンスを生成し、ファイルを検索したいフォルダのトップ階層のパスのフォルダを取得する処理のコードです。
FileSystemObjectのインスタンスのGetFolderメソッドに、ファイルを検索したいフォルダのトップ階層のパスを指定して実行することで、パス内のファイル名を取得できます。
注目すべきコード③
次に見て頂きたいのは51行目から79行目です。
'フォルダ名貼り付け用シート有無のチェック
For Each ws In Worksheets
If ws.Name = dtSheetNM Then
'シート「data」が存在している場合
'変数「shtExistFlg」にTrueを設定する
shtExistFlg = True
End If
Next ws
If shtExistFlg = False Then
'シート「data」が存在しない場合
'テーブルから取得するデータを列挙するためのシートを新規作成する
Worksheets.Add(After:=Worksheets(Worksheets.count)) _
.Name = dtSheetNM
Else
'シート「data」が存在する場合
'シート「data」のセル全てをクリアする
Worksheets(dtSheetNM).Cells.Clear
End If
コードの説明
以上のコードは、サブフォルダ含めて全フォルダ名を階層ごとに書き出すシート「data」を生成する処理のコードです。
シート「data」を生成するかどうかは、Excelファイル上に存在しない場合に生成します。
なので、まずはシート「data」がExcelファイルに存在するかを判定し、存在しない場合に生成します。
コードの詳細
51行目のコードでは、Excelファイル内にあるシートを一つ一つ取得するためのFor文を用意しています。
もしExcelファイルに3つシートが存在していれば、For文内を3回ループします。
For文をループする中で、取得したシート名とシート名「data」(定数dtSheetNMの値)が一致するかを53行目で判定します。
もし一致すれば、Excelファイルの中にシート「data」が存在していることが分かったので、58行目で変数shtExistFlgにTrueを設定します。
64行目で変数shtExistFlgの値を確認し、Falseの場合(シート「data」が存在しない場合)は、69行目と70行目でシート「data」を生成します。
Trueの場合(72行目)はシート「data」が存在しているので、77行目でそのシート「data」をクリアします。(フォルダ名を出力するため)
注目すべきコード④
次に見て頂きたいのは101行目です。
'フォルダ名を検索するサブルーチンを呼び出す
Call folderSearch(folder, colPos + 1, rowPos + 1, ws)
コードの説明
以上のコードは、サブフォルダ含めて全てのフォルダ内のファイルを検索するサブルーチン「fileSearch」を呼び出す処理です。
「fileSearch」には以下の引数を渡して呼び出します。
- 第1引数：フォルダ
- 第2引数：列位置
- 第3引数：行位置
- 第4引数：データの出力先のワークシート
第1引数：フォルダ
第1引数には、フォルダを指定します。
フォルダ名の取得や、フォルダ内のフォルダ名(サブフォルダ名)を取得するのに使います。
第2引数：列位置
第2引数には、列位置を指定します。
どの列にフォルダ名を出力するのか、その何列目かの値に使います。
第3引数：行位置
第3引数には、行位置を指定します。
主にどの列にフォルダ名を出力するのか、その何列目かの値に使います。
第4引数：データの出力先のワークシート
第4引数にはデータの出力先のワークシートを指定します。
今回では、データの出力先のワークシートは「data」になります。
注目すべきコード⑤
次に見て頂きたいのは139行目です。
If folder.SubFolders.count > 0 Then
コードの説明
以上のコードは、フォルダ内にフォルダ(サブフォルダ)があるのかを判定するIF文のコードです。
フォルダ内にフォルダ(サブフォルダ)がある場合はcountプロパティが1以上を返します。(サブフォルダの数)
countプロパティが1以上を返す場合は、144行目の処理に遷移し、0を返す場合は何もしません。(195行目に遷移する。次のフォルダに移ってサブフォルダがないか見に行く)
なお、144行目(以降)の処理は、フォルダ名を取得処理です。
注目すべきコード⑥
次に見て頂きたいのは144行目です。
'フォルダ内のフォルダの数だけ処理を行うFor文
For Each subFolder In folder.SubFolders
コードの説明
以上のコードは、フォルダの中にあるフォルダ(サブフォルダ)の数だけフォルダ(サブフォルダ)を取得するFor文のコードです。
サブフォルダは変数subFolderに格納されます。
なお、変数subFolderからフォルダ名を取得することができます。
注目すべきコード⑦
次に見て頂きたいのは147行目から165行目です。
'列の数だけ処理を繰り返すFor文
For cnt = 1 To colPos - 1
If IsNumeric(ws.Cells(rowPos - 1, cnt).Value) Then
'フォルダ名が数値の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, cnt).Value = "'" & CStr(ws.Cells(rowPos - 1, cnt).Value)
Else
'フォルダ名が数値以外の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, cnt).Value = ws.Cells(rowPos - 1, cnt).Value
End If
Next cnt
コードの説明
以上のコードは、取得したフォルダの親フォルダをセルに出力する(セルを埋める)処理のコードです。
セルを埋めるというのは、以下のオレンジ色を付けたセルに(親の)フォルダ名を出力した状態のことを指します。
セルを埋めてない状態は以下のとおりです。
空白が目立ち寂しく見えますね(;´Д｀)
改めてセルを埋めると以下のとおりに出力されます。
以上が今回のマクロの出力結果としています。
コードの詳細
147行目のコードは、列の数だけ処理を繰り返すFor文です。
149行目のコードは、例えばフォルダ名が「00123」という名前だった場合に「123」とならないように、フォルダ名が数値かどうかを判定するIFです。(IsNumeric関数で判定(TRUEなら数値、FALSEなら数値以外))
もし数値の場合は、154行目でセルにフォルダ名を出力します。
セルにフォルダ名を出力する際は、フォルダ名の頭に「’」(カンマ)を付けています。
フォルダ名の頭に「’」(カンマ)を付けることで、例えばフォルダ名が「00123」という名前だった場合でも「123」とはならず「00123」とセルに出力されます。
数値以外の場合は、161行目でフォルダ名をそのままセルに出力しています。
注目すべきコード⑧
次に見て頂きたいのは167行目から181行目です。
If IsNumeric(subFolder.Name) Then
'フォルダ名が数値の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, colPos).Value = "'" & CStr(subFolder.Name)
Else
'フォルダ名が数値以外の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, colPos).Value = subFolder.Name
End If
コードの説明
以上のコードは、取得したフォルダ名をセルに出力する処理のコードです。
コードの詳細
167行目のコードは、例えばフォルダ名が「00123」という名前だった場合に「123」とならないように、フォルダ名が数値かどうかを判定するIFです。(IsNumeric関数で判定(TRUEなら数値、FALSEなら数値以外))
もし数値の場合は、172行目でセルにフォルダ名を出力します。
セルにフォルダ名を出力する際は、フォルダ名の頭に「’」(カンマ)を付けています。
フォルダ名の頭に「’」(カンマ)を付けることで、例えばフォルダ名が「00123」という名前だった場合でも「123」とはならず「00123」とセルに出力されます。
数値以外の場合は、179行目でフォルダ名をそのままセルに出力しています。
注目すべきコード⑨
次に見て頂きたいのは186行目です。
'パスのサブフォルダを対象にループする
Call folderSearch(subFolder, colPos + 1, rowPos, ws)
コードの説明
以上のコードは、サブフォルダが存在する間は自分自身のサブルーチンを繰り返し呼び出す再帰処理を行っているコードです。
再帰処理とは、サブルーチンの処理が行われている途中で、強制的に自分自身のサブルーチンを呼び出して再度サブルーチンの最初から処理を行わせることを言います。
強制的に自分自身のサブルーチンを呼び出しているのは185行目です。
185行目でfolderSearchが呼び出されると、folderSearchの処理の途中で134行目(folderSearchの最初)から強制的に開始されます。
すべてのフォルダを取得してExcelのシートに書き出したら、folderSearchの呼び出し元の101行目に遷移します。
そのまま103行目の次の行に処理が遷移します。
注目すべきコード⑩
次に見て頂きたいのは103行目から124行目です。
For cnt = 2 To ws.Columns.count
' 各列に値があるか確認します。
Set rng = ws.Columns(cnt).Find("*", LookIn:=xlValues)
If rng Is Nothing Then
'列に値が無い場合
'ループを抜ける
Exit For
Else
'列に値がある場合
'1行目のセルに「階層n」の文字列を出力する
ws.Cells(1, cnt).Value = "階層" & cnt - 1
End If
Next cnt
コードの説明
以上のコードは、1行目のセルに「階層n」の文字列を出力する処理のコードです。
1行目のセルに「階層n」の文字列を出力するというのは、以下の赤枠の部分の出力のことを指します。
コードの詳細
103行目は、Excelの最大列数(16,384列)だけ処理を繰り返すFor文です。
106行目は、列に値があるかを検索する処理のコードです。
もし列に値が無い場合は113行目でFor文を抜けます。
もし列に値がある場合は120行目で、1行目のセルに「階層n」の文字列を出力します。
動作確認
「Excelファイルの例」をご覧ください。
最後に
この記事では、サブフォルダ含めて全フォルダ名を階層ごとにExcelのシートに書き出す方法についてご説明しました。
フォルダの中にあるフォルダ構成がどうなっているのかをぱっと目で見て確認したい場合は本記事を参考にしてみてくださいね。
プログラミングのスキルを習得するなら
プログラミングのスキルを習得したい、今のスキルをもっと高めたい、そう考えているなら「プログラミングスクール」がおすすめです。
プログラミングのスキルの基礎を身につけるなら「TechAcademy」で1週間の無料体験があるので、これで「プログラミングの基礎」を学ぶのにおすすめですよ。
