Private Sub Command1_Click()
' Erstelle neue Ordner: 
    MakeDir "C:\Hallo\Neu"
 
End Sub 

Private Sub MakeDir(Bezeichnung$)
On Error Resume Next 
' Erstellt beliebig viele Ordner samt Unterordner 
Dim Verzeichnis As String 
Dim Bezei As String 
 
  Bezei = Bezeichnung
  Verzeichnis = Left(Bezei, 3)
  Bezei = Right(Bezei, Len(Bezei) - 3)
 
  If Right(Bezei, 1) <> "\" Then Bezei = Bezei & "\"
  Verzeichnis = Verzeichnis & _
  Mid(Bezei, 1, InStr(Bezei, "\") - 1)
 
  Bezei = Right(Bezei, Len(Bezei) - InStr(Bezei, "\"))
  While Right(Verzeichnis, 1) <> "\"
    MkDir Verzeichnis
    If Bezei <> "" Then 
        Verzeichnis = Verzeichnis & "\" + _
        Mid(Bezei, 1, InStr(Bezei, "\") - 1)
    Else 
        Verzeichnis = Verzeichnis & "\"
    End If 
    Bezei = Right(Bezei, Len(Bezei) - InStr(Bezei, "\"))
  Wend
 
  Exit Sub 
 
  Err = 0
 
End Sub