계층 구조가 다양하게 건너는 폴더 트리의 작성은 귀찮네요.
일로 그런 필요가 생겼기 때문에 만들어 보았습니다.

코드

MakeFolderTree.bas

Option Explicit

Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" ( _
                                                                  ByVal hwnd As Long, _
                                                                  ByVal pszPath As String, _
                                                                  ByVal psa As Long) As Long

Public Const ADR_ROOT       As String = "B2"        ' ツリーのルートフォルダ格納セル(controlシート)
Public Const ADR_FOL_ROOT   As String = "A3"        ' ツリーのルートフォルダ格納セル(treeシート)

Public Const SHT_CTRL       As String = "control"
Public Const SHT_TREE       As String = "tree"

Sub MakeFolderTree()
'*****************************************************
' treeシートに設定したツリー構造でフォルダを作成する
'*****************************************************
    Dim rPath, fPath As String
    Dim csh, tsh As Object
    Dim enRow, enCol, enColMax As Long
    Dim stAdd, enAdd, lastAdd As String
    Dim stRow, lpRow, difRow, lpCol As Long
    Dim pArr(), lastArr() As Variant
    Dim xlfunc As Object
    Dim varFol As String
    Dim sep As String

    Set csh = Sheets(SHT_CTRL)
    Set tsh = Sheets(SHT_TREE)
    Set xlfunc = Application.WorksheetFunction
    sep = Application.PathSeparator         ' Pathの区切り記号("\")

    rPath = csh.Range(ADR_ROOT).Value       ' フォルダツリーのルートフォルダ
    tsh.Range(ADR_FOL_ROOT).Value = rPath   ' treeシートにルートフォルダを入力
    stAdd = ADR_FOL_ROOT                    ' フォルダツリーの先頭セル
    stRow = tsh.Range(stAdd).Row            ' フォルダツリーの先頭行
    lastAdd = tsh.Cells.SpecialCells(xlCellTypeLastCell).Address(False, False, xlA1)  ' フォルダツリーの最終セル
    enRow = tsh.Range(lastAdd).Row          ' フォルダツリーの最終行
    difRow = enRow - stRow                  ' フォルダツリーの枝数 - 1

    '---- ツリー各行の階層数を取得する
    ReDim lastArr(difRow)                   ' ツリー各行の最下層列番号を格納する配列
    For lpRow = 0 To difRow
        enCol = tsh.Cells(stRow + lpRow, Columns.Count).End(xlToLeft).Column
        lastArr(lpRow) = enCol
    Next lpRow
    enColMax = xlfunc.Max(lastArr)          ' 一番深い階層数を取得
    ReDim pArr(difRow, enColMax - 1)        ' ツリー各行のフォルダパスを格納する配列

    '---- フォルダ階層を配列に格納
    For lpRow = 0 To difRow                 ' 行方向Scan
        For lpCol = 0 To lastArr(lpRow) - 1 ' 列方向Scan
            varFol = tsh.Range(stAdd).Offset(lpRow, lpCol).Value
            If varFol = "" Then
                '---- 親フォルダが空欄の時は1つ前の値を代入
                pArr(lpRow, lpCol) = pArr(lpRow - 1, lpCol)
            Else
                pArr(lpRow, lpCol) = varFol
            End If
        Next lpCol
    Next lpRow

    '---- フォルダ作成
    For lpRow = 0 To difRow
        fPath = ""
        For lpCol = 0 To lastArr(lpRow) - 1
            If lpCol = lastArr(lpRow) - 1 Then
                fPath = fPath & pArr(lpRow, lpCol)
            Else
                fPath = fPath & pArr(lpRow, lpCol) & sep
            End If
        Next lpCol
        Call SHCreateDirectoryEx(0&, fPath, 0&) '<-- フォルダ一発作成
    Next lpRow
End Sub

Sub SelectFolder()
'*****************************************************
' ルートフォルダを選択するメソッド
'*****************************************************
    Dim csh As Object
    Set csh = Sheets(SHT_CTRL)

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            csh.Range(ADR_ROOT).Value = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

End Sub

Excel 시트

control 시트
루트 폴더 지정을 위해 [...] 버튼에 SelectFolder를 등록합니다.

tree 시트
루트 폴더 다음 트리 구성은 다음과 같이 설명합니다. 계층 수에는 제한이 없습니다. 상위 폴더가 같으면 공백이 될 수 있습니다.

사용방법

임의 이름의 .xlsm 파일을 만들고 코드를 표준 모듈로 가져오기(copipe)합니다.
그런 다음 시트로 "control"과 "tree"를 준비하십시오. 각 시트의 설정은 이미지를 참고하여 주십시오.
트리 시트에 트리 구성을 작성한 후 control 시트에서 루트 폴더를 지정하고 실행 버튼을 누릅니다.

해설

처리의 흐름으로서는, tree 시트에 기재한 구성을 2차원 배열에 저장해, SHCreateDirectoryEx API를 사용해 폴더 패스를 일발 작성하고 있습니다.
Excel 시트는 최대한의 심플함을 염두에두고 만들었습니다. 나는 디자인 센스가 없기 때문에 시트 내 디자인은 원하는대로!
tree 시트는 부모 폴더가 같으면 공란으로 하는 것이 전망이 좋기 때문에, 매크로측에서 궁리하는 것으로 실현했습니다. 이 때문에, 배열을 복수 사용하거나 루프가 많아지고 있습니다.

참고 사이트

존재하지 않는 경로의 폴더를 한 번에 생성 (Office TANAKA)