Excel VBA 指定ディレクトリ内のフォルダ名を表示（その１）

[ExcelVBA]指定ディレクトリ内のフォルダ名を表示（その１）
前提条件

・A1セルにディレクトリパスを入力しておくこと
(例：C:\)

・サブプロシージャを以下の順で実行すること

showFolderCnt1() → showFolderList1() → showLine1()

サブプロシージャ

showFolderCnt1()
B1セルにフォルダの数を表示

showFolderList1()
以下のようにフォルダを表示

例)
folder1←B2セル
folder2←B3セル
folder3←B4セル
・
・
/←終わり

showLine1()
以下のように線を引く

例)
・フォルダが1つ

└───folder1

・フォルダが2つ

├───folder1
└───folder2

・フォルダが3つ

├───folder1
├───folder2
└───folder3

Option Explicit Sub showFolderCnt1()     '==========================     'A1セルの文字列を取得     '==========================     Dim rootStr As String     rootStr = Cells(1, "A").Value          If Right(rootStr, 1) <> "\" Then         rootStr = rootStr & "\"     End If          '==========================     'フォルダ数分ループ     '==========================     Dim folName As String     '一番最初のフォルダ     folName = Dir(rootStr, vbDirectory)          Dim Cnt As Integer     Cnt = 0     Do While folName <> ""         If folName <> "." And folName <> ".." Then             'フォルダ名のみカウントする             '(※dir関数はフォルダが存在しない場合ファイルを表示してしまうので)             If (GetAttr(rootStr & "\" & folName) And vbDirectory) = vbDirectory Then                 Cnt = Cnt + 1             End If         End If                  folName = Dir   '次のフォルダへ     Loop          'B1セルにフォルダ数を表示     Cells(1, "B").Value = Cnt      End Sub Sub showFolderList1()          '==========================     'A1セルの文字列を取得     '==========================     Dim rootStr As String     rootStr = Cells(1, "A").Value          If Right(rootStr, 1) <> "\" Then         rootStr = rootStr & "\"     End If          '==========================     'フォルダ数分ループ     '==========================     Dim folName As String     '一番最初のフォルダ     folName = Dir(rootStr, vbDirectory)          Dim y As Integer     y = 2   '2行目     Do While folName <> ""         If folName <> "." And folName <> ".." Then             'フォルダ名のみ表示する             '(※dir関数はフォルダが存在しない場合ファイルを表示してしまうので)             If (GetAttr(rootStr & "\" & folName) And vbDirectory) = vbDirectory Then                 'B?に表示                 Cells(y, "B").Value = folName                 y = y + 1             End If         End If                  folName = Dir   '次のフォルダへ     Loop     Cells(y, "B").Value = "/"   '←終了 End Sub Sub showLine1() 'B1セルよりフォルダ数を取得 Dim folCnt As Integer folCnt = Cells(1, "B").Value If folCnt = 0 Then     '何もしないで終了     Exit Sub      ElseIf folCnt = 1 Then     'A2セル     Cells(2, "A").Value = "└───" ElseIf folCnt = 2 Then     'A2セル     Cells(2, "A").Value = "├───"     'A3セル     Cells(3, "A").Value = "└───" ElseIf folCnt > 2 Then     'A2セル     Cells(2, "A").Value = "├───"          'A2セル〜A?(最終セルの手前)     Dim y As Integer     For y = 3 To folCnt         Cells(y, "A").Value = "├───"     Next y          '最終セルはフォルダ数+1     Cells(folCnt + 1, "A").Value = "└───" Else     '何もしないで終了     Exit Sub End If End Sub