サブディレクトリまで一気に構造できるCreateFolder

VBAのFileSystemObjectではCreateFolderがありますが、ちょっとまじめすぎる。
例えば c:\hogeが存在しない前提で、c:\hoge\work\　を作成しようとすると、エラーが出します。

やりたいことはサブフォルダーを含め、一括複数層のフォルダ構造を一気に作成することです。

Function xCreateFloder(path)
    Dim tp As Variant
    Dim FSO As New Scripting.FileSystemObject
    Dim pp As String
    
    pp = ""
    tp = Split(path, "\")
    For Each p In tp
        pp = pp & IIf(pp = "", "", "\") & p
        If Not FSO.FolderExists(pp & "\") Then
            FSO.CreateFolder pp
        End If
    Next p
    Set FSO = Nothing
End Sub

追加「\\」から始まるネットドライブ対応バージョン
前提は書き込み権限あり

Public Function xCreateFloder(path) As Boolean
    Dim tp As Variant
    Dim FSO As New Scripting.FileSystemObject
    Dim pp As String
    Dim p As Variant
    Dim netDrive As Boolean
    Dim tpath As String
    
    xCreateFloder = False
    
    If Left(path, 2) = "\\" Then
        netDrive = True
        path = Replace(path, "\\", "")
    End If
    
    pp = ""
    tp = Split(path, "\")
    For Each p In tp
        If netDrive Then
            pp = pp & IIf(pp = "", "", "\") & p
            tpath = IIf(netDrive, "\\", "") & pp & "\"
            Shell "cmd /c mkdir " & tpath, vbHide
        Else
            pp = pp & IIf(pp = "", "", "\") & p
            If Not FSO.FolderExists(pp & "\") Then
                FSO.CreateFolder pp
            xCreateFloder = True
            End If
        End If
    Next p
    Set FSO = Nothing
End Function

使い例

xCreateFloder "\\nas\abc"
xCreateFloder "c:\abc"