この記事では、サブフォルダ含めて全フォルダ名を階層ごとにExcelのシートに書き出す方法についてご説明します。
本記事のマクロは、以下の記事のマクロの出力結果を変えたマクロになります。
【ExcelVBA】サブフォルダ含めて全フォルダ名を階層ごとにExcelのシートに書き出すには①
【動画】サブフォルダ含めて全フォルダ名を階層ごとにExcelのシートに書き出す実際の動き
本題に入る前に、まずは次の動画をご覧ください。
まずは指定されたトップディレクトリ配下にあるすべてのフォルダ内の階層構造を再帰的に解析してフォルダ名を取得します。
取得したフォルダを、階層順に1つずつExcelのシートに書き出します。
マクロ作成の流れ
Excelファイルの例
今回は次のExcelファイルを用意しました。
A2の黄色のセルにフォルダのフルパスを入力して実行ボタンをクリックすると、以下のようにシート「data」が生成されてサブフォルダ含めて全フォルダ名を階層ごとに書き出されます。
ちなみに、トップフォルダ配下にあるフォルダ内のファイルは下のとおりです。
コードの例
Option Explicit
Private Sub btn_exec_Click()
Dim colPos As Long '行位置用変数
Dim rowPos As Long '列位置用変数
Dim fso As Object 'FileSystemObjectのインスタンス用変数
Dim Folder As Object 'フォルダ用変数
Dim wstop As Worksheet 'ワークシート用変数(シート「top」用)
Dim ws As Worksheet 'ワークシート用変数(作業用)
Dim dirPath As String 'ファイルのパスを格納する変数
Dim shtExistFlg As Boolean 'シート存在確認フラグ
Dim cnt As Long 'カウンタ用変数
Dim rng As Range 'Rangeオブジェクト格納用変数
'フォルダ名を出力するシート名
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)
'フォルダ名を検索するサブルーチンを呼び出す
Call folderSearch(Folder, colPos, rowPos, 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 Folder = Nothing
Set fso = Nothing
Set ws = Nothing
Set wstop = 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 IsNumeric(Folder.Name) Then
'フォルダ名が数値の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, colPos).Value = "'" & CStr(Folder.Name)
Else
'フォルダ名が数値以外の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, colPos).Value = Folder.Name
End If
If Folder.SubFolders.Count > 0 Then
'フォルダ内にフォルダが存在している場合
'フォルダ内のフォルダの数だけ処理を行うFor文
For Each SubFolder In Folder.SubFolders
'パスのサブフォルダを対象にループする
Call folderSearch(SubFolder, colPos + 1, rowPos, ws)
Next SubFolder
Else
'フォルダ内にフォルダが存在していない場合(最下層までたどり着いた場合)
'列の数だけ処理を繰り返すFor文
For cnt = 1 To colPos - 1
If ws.Cells(rowPos, cnt).Value = "" Then
'セルに値が無い場合
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
Else
'セルに値がある場合
'ループを抜ける
Exit For
End If
Next cnt
'最下層に達したので次の行に移動するためカウンタを1つ増やす
rowPos = rowPos + 1
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」をクリアします。(フォルダ名を出力するため)
注目すべきコード④
次に見て頂きたいのは84行目です。
'フォルダ名を検索するサブルーチンを呼び出す
Call folderSearch(Folder, colPos, rowPos, ws)
コードの説明
以上のコードは、サブフォルダ含めて全てのフォルダ内のファイルを検索するサブルーチン「fileSearch」を呼び出す処理です。
「fileSearch」には以下の引数を渡して呼び出します。
- 第1引数：フォルダ
- 第2引数：列位置
- 第3引数：行位置
- 第4引数：データの出力先のワークシート
第1引数：フォルダ
第1引数には、フォルダを指定します。
フォルダ名の取得や、フォルダ内のフォルダ名(サブフォルダ名)を取得するのに使います。
第2引数：列位置
第2引数には、列位置を指定します。
どの列にフォルダ名を出力するのか、その何列目かの値に使います。
第3引数：行位置
第3引数には、行位置を指定します。
主にどの列にフォルダ名を出力するのか、その何列目かの値に使います。
第4引数：データの出力先のワークシート
第4引数にはデータの出力先のワークシートを指定します。
今回では、データの出力先のワークシートは「data」になります。
注目すべきコード⑤
次に見て頂きたいのは123行目から137行目です。
If IsNumeric(Folder.Name) Then
'フォルダ名が数値の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, colPos).Value = "'" & CStr(Folder.Name)
Else
'フォルダ名が数値以外の場合
'フォルダ名をシートに出力
ws.Cells(rowPos, colPos).Value = Folder.Name
End If
コードの説明
以上のコードは、フォルダ名をExcelのシートに出力する処理のコードです。
コードの詳細
123行目のコードは、例えばフォルダ名が「00123」という名前だった場合に「123」とならないように、フォルダ名が数値かどうかを判定するIFです。(IsNumeric関数で判定(TRUEなら数値、FALSEなら数値以外))
もし数値の場合は、128行目でセルにフォルダ名を出力します。
セルにフォルダ名を出力する際は、フォルダ名の頭に「’」(カンマ)を付けています。
フォルダ名の頭に「’」(カンマ)を付けることで、例えばフォルダ名が「00123」という名前だった場合でも「123」とはならず「00123」とセルに出力されます。
数値以外の場合は、135行目でフォルダ名をそのままセルに出力しています。
注目すべきコード⑥
次に見て頂きたいのは139行目から149行目です。
If Folder.SubFolders.Count > 0 Then
'フォルダ内にフォルダが存在している場合
'フォルダ内のフォルダの数だけ処理を行うFor文
For Each SubFolder In Folder.SubFolders
'パスのサブフォルダを対象にループする
Call folderSearch(SubFolder, colPos + 1, rowPos, ws)
Next SubFolder
コードの説明
以上のコードは、フォルダの中にフォルダが存在するか(サブフォルダが存在するか)を判定し、存在している場合は自分自身のサブルーチンfolderSearchを呼び出す再帰処理を行う処理のコードです。
例えば「file¥2¥2_1¥2_1_1」という構成のフォルダがあるとします。
以上の最下層のフォルダは「2_1_1」ですが、再帰処理を使って、「file」のフォルダ(トップディレクトリ)から順に「2_1_1」まで一つずつ下の階層をたどっていきます。
再帰処理とは、サブルーチンの処理の途中で、自分自身のサブルーチンfolderSearchを呼び出す処理のことを言います。
まずは「file」というフォルダが見つかったら、自分自身のサブルーチンfolderSearchを呼び出して再度folderSearchを頭から実行させます。
次に1つ下の階層にフォルダがあるかを検索し、「2_1」が見つかります。
次に「2_1」のフォルダの1つ下の階層にフォルダがあるかを検索し、「2_1_1」が見つかります。
次に「2_1_1」のフォルダの1つ下の階層にフォルダがあるかを検索し、もう下の階層にはフォルダが見つからないので139行目のIFの条件には該当しないのでELSEの条件に進みます。
ELSEの条件の処理については「注目すべきコード⑦」をご覧ください。
一つずつ下の階層をたどる途中で、自身のサブルーチンfolderSearchを呼び出してフォルダ名をExcelのシートに出力します。
なお、フォルダ名をExcelのシートに出力するのは、「注目すべきコード⑤」の項目を参照してください。
「file¥2¥2_1¥2_1_1」というフォルダ構成なら、「file」→「2」→「2_1」→「2_1_1」の順にExcelのシートに出力されます。
注目すべきコード⑦
次に見て頂きたいのは151行目から192行目です。
Else
'フォルダ内にフォルダが存在していない場合(最下層までたどり着いた場合)
'列の数だけ処理を繰り返すFor文
For cnt = 1 To colPos - 1
If ws.Cells(rowPos, cnt).Value = "" Then
'セルに値が無い場合
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
Else
'セルに値がある場合
'ループを抜ける
Exit For
End If
Next cnt
'最下層に達したので次の行に移動するためカウンタを1つ増やす
rowPos = rowPos + 1
End If
コードの説明
以上のコードは、フォルダ内にフォルダが存在していない場合(または最下層までたどり着いた場合)、親フォルダ名をすべてExcelのセルに出力する処理のコードです。
親フォルダ名をすべてセルに出力させないと以下のように空白のセル(以下の画像ではA3からA5のセル)が発生してしまいます。
親フォルダ名をすべてExcelのセルに出力すると下のとおりになります。
フォルダ名だけでなく親フォルダ名も出力されています。
コードの詳細
151行目は、フォルダ内にフォルダが存在していない場合(または最下層までたどり着いた場合)の条件のELSEです。
フォルダ内にフォルダが存在していない場合(または最下層までたどり着いた場合)は、親フォルダ名がすべてExcelのシートに出力されているか確認し、出力されていなければ親フォルダ名を出力します。
親フォルダ名を出力するには、まず156行目のFor文のループに遷移し、A列のセルから順に親フォルダ名がセルに出力されているかを確認します。その確認が158行目です。
158行目では、セルに値(親フォルダ名)が無いかを確認します。
親フォルダ名が無い場合は、167行目で一つ上の値をそのままセルに出力します。
ただし、フォルダ名が数値型、例えば「00123」という名前だった場合にそのままセルに「00123」の値を出力してしまうと、「123」と出力されてしまいます。
理由は、セルが文字列に変換して先頭の「0」を削除して出力してしまうからです。
なので、対策として値の頭に「’」(カンマ)を付けることで「00123」とセルに出力されるよう対応します。
手順としてはまずは、162行目でセルの値が数値なのか数値以外なのかを判定します。
もしセルの値が数値の場合は、167行目でフォルダ名を文字列型に変換し、その値の頭に「’」(カンマ)を付けてExcelのシートに出力しています。
値の頭に「’」(カンマ)を付けることで、フォルダ名が「00123」という名前だった場合でも「123」とはならず「00123」とセルに出力されます。
数値以外の場合は、174行目でフォルダ名をそのままセルに出力しています。
ここまででフォルダ名と親フォルダ名すべてがセルに出力されたので、新たなフォルダ階層に移るために190行目でrowPos(行位置)の値を1つ増やします。
動作確認
「Excelファイルの例」をご覧ください。
最後に
この記事では、サブフォルダ含めて全フォルダ名を階層ごとにExcelのシートに書き出す方法についてご説明しました。
フォルダの中にあるフォルダ構成がどうなっているのかをぱっと目で見て確認したい場合は本記事を参考にしてみてくださいね。
なお、今回のマクロは最下層のフォルダごとに1行ずつ出力しているのですが、以下の記事のマクロでは全てのフォルダごとに1行ずつ出力しています。
詳細については以下の記事で説明しているのでそちらの記事も見て頂けたら幸いです。
【ExcelVBA】サブフォルダ含めて全フォルダ名を階層ごとにExcelのシートに書き出すには①
- リンク先のマクロの出力結果：全てのフォルダごとに1行ずつ出力
- 今回のマクロの出力結果：最下層のフォルダごとに1行ずつ出力
プログラミングのスキルを習得するなら
プログラミングのスキルを習得したい、今のスキルをもっと高めたい、そう考えているなら「プログラミングスクール」がおすすめです。
プログラミングのスキルの基礎を身につけるなら「TechAcademy」で1週間の無料体験があるので、これで「プログラミングの基礎」を学ぶのにおすすめですよ。
