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

ExcelVBA

FileSystemObjectを使用する

前回はDir関数を使用しました。
今回は前回と同様の処理をFileSystemObjectを使います。

FileSystemObjectは以下のように生成します。

    Dim objFS As FileSystemObject
    Set objFS = CreateObject("Scripting.FileSystemObject")

GetFolderメソッドからFolderオブジェクトを取得できます。

    Dim Fols As Folders
    Set Fols = objFS.GetFolder(dPath)

Folderオブジェクトからサブフォルダの数を取得できます。

    Fols.SubFolders.Count

Folderオブジェクトからルートフォルダ名を取得できます。

    Fols.Name

今回の場合はFileSystemObjectオブジェクトからサブフォルダのFolderオブジェクトを取得し、そこからサブフォルダ名を取得します。

    Dim folName
    For Each folder In objFS.GetFolder(dPath).SubFolders
        folName = folder.Name
    Next





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


Option Explicit



Sub showFolderCnt1()



    'A1セルの文字列を取得する

    Dim dPath As String

    dPath = Cells(1, "A").Value

    

    '空の場合は終了

    If dPath = "" Then Exit Sub

    

    '末尾が「\」じゃなかったら付加する

    If Right(dPath, 1) <> "\" Then

        dPath = dPath & "\"

    End If

    

    'FileSystemオブジェクトを取得する

    Dim objFS As FileSystemObject

    Set objFS = CreateObject("Scripting.FileSystemObject")

    

    'サブフォルダーの数を取得する

    Dim Cnt As Long

    On Error GoTo Err

    Cnt = objFS.GetFolder(dPath).SubFolders.Count

    On Error GoTo 0

    

    'オブジェクトを解放する

    Set objFS = Nothing

    

    'B1セルに表示する

    Cells(1, "B").Value = Cnt

    

Exit Sub



Err:

'サブフォルダを取得できなかったら終了

Exit Sub

End Sub



Sub showFolderList1()



    'A1セルの文字列を取得する

    Dim dPath As String

    dPath = Cells(1, "A").Value

    

    '空の場合は終了

    If dPath = "" Then Exit Sub

    

    '末尾が「\」じゃなかったら付加する

    If Right(dPath, 1) <> "\" Then

        dPath = dPath & "\"

    End If

    

    'FileSystemオブジェクトを取得する

    Dim objFS As FileSystemObject

    Set objFS = CreateObject("Scripting.FileSystemObject")

    

    'サブフォルダー数分ループ

    Dim folder As folder

    Dim y As Long

    y = 2

    On Error GoTo Err

    For Each folder In objFS.GetFolder(dPath).SubFolders

        'フォルダ名y番目のセルに表示

        Cells(y, "B").Value = folder.Name

        y = y + 1

    Next

    On Error GoTo 0

    

    'オブジェクトを解放する

    Set objFS = Nothing

    

    Cells(y, "B").Value = "/"   '←終了

    

Exit Sub



Err:

'サブフォルダを取得できなかったら終了

Exit Sub



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