Beispiel:

Option Explicit
 
Public Type SECURITY_ATTRIBUTES
  nLength                As Long
  lpSecurityDescriptor   As Long
  bInheritHandle         As Long
End Type
 
Public Function CreateNestedFoldersByPath(ByVal sPath As String) As Long
'// -----------------------------------------------------------------
'// Methode:   | Erstellung eines beliebigen Ordnerpfades
'//            | benötigt Hilfsprozedur GetPart()
'// -----------------------------------------------------------------
'// Parameter: | sPath = anzulegender Pfad; z.B.:
'//            | "C:\DIR1\DIR2\DIR3\DIR4\DIR5" ...
'// -----------------------------------------------------------------
'// Rückgabe:  | Anzahl neu angelegter Order
'// -----------------------------------------------------------------
    On Error GoTo Err_CreateNestedFoldersByPath
    Dim uSecAttr         As SECURITY_ATTRIBUTES
    Dim asFolders()      As String
    Dim sNewDirectory    As String
    Dim sDrvPart         As String
    Dim sItem            As String
    Dim lResult          As Long
    Dim lCount           As Long
    Dim lPos             As Long
 
    sPath = QualifyPath(sPath)
    lPos = VBA.InStr(sPath, ":")
    If lPos Then
          sDrvPart = GetPart(sPath, "\")
    Else: sDrvPart = ""
    End If
    Do Until VBA.Len(sPath) = 0
        sItem = GetPart(sPath, "\")
        On Error GoTo Err_CreateNestedFoldersByPath
        ReDim Preserve asFolders(0 To lCount) 'As String
        If lCount = 0 Then sItem = sDrvPart & sItem
        asFolders(lCount) = sItem
        lCount = lCount + 1
    Loop
    lCount = -1
    Do
        lCount = lCount + 1
        sNewDirectory = sNewDirectory & asFolders(lCount)
        uSecAttr.nLength = LenB(uSecAttr)
        If Not FolderExists(UnQualifyPath(sNewDirectory)) Then
            lResult = CreateDirectory(sNewDirectory, uSecAttr)
            If lResult = 0 Then
                CreateNestedFoldersByPath = False
                GoTo Exit_CreateNestedFoldersByPath
            End If
        End If
    Loop Until lCount = UBound(asFolders)
    CreateNestedFoldersByPath = lCount + 1
 
Exit_CreateNestedFoldersByPath:
    Erase asFolders
    On Error GoTo 0
    Exit Function
 
Err_CreateNestedFoldersByPath:
    GoTo Exit_CreateNestedFoldersByPath
 
End Function