Dim fs As New FileSystemObject

Private Sub Command1_Click()
'Skickar den angivna sökvägen till vår sub buildPath
buildPath (Text1.Text)
End Sub

Private Sub buildPath(toCreate As Variant)
Dim dirArr As Variant
Dim path As Variant

'Dela upp sökvägen i bitar så att man får ett mappnamn i varje arraypost
dirArr = Split(toCreate, "\")
'Roten ska ju finnas från början, så den lägger vi till i vår variabel "path"
path = dirArr(0)

'Skapa mappar så länge som det finns mappnamn att skapa
For i = 1 To UBound(dirArr)
'Lägg till sökväg att skapa, bitvis
path = path & "\" & dirArr(i)
'Och om denna mapp ej finns... Skapa den
If Not fs.FolderExists(path) Then fs.CreateFolder (path)
Next i

End Sub

'################################################
'Det var allt. Enkelt!
'Lite felkontroll kan ju behövas också.
'Kolla efter "\\", tomt mappnamn, otillåtna tecken m.m.
'Men det blir upp till er ;O)
'################################################