Puoi usare una funzione ricorsiva ... (trovata in rete)

codice:
Private Sub CreateFolder (FolderName as string)
  Dim fso As FileSystemObject
  Dim iBreak As Integer

  On Error Resume Next

  iBreak = InStrRev(FolderName, "\")
  If iBreak > 0 Then
    Call CreateFolder(Left$(FolderName, iBreak - 1))
  End If

  Set fso = New FileSystemObject
  If fso.FolderExists(FolderName) = False Then
    fso.CreateFolder FolderName
  End If
  Set fso = Nothing
End Sub
da usarsi con

codice:
CreateFolder("C:\Cartella1\Cartella2\Cartella3")

P.S. Non e' bene riprendere vecchi messaggi anche se hanno a che fare con il tuo problema ... costringi a leggerli tutti quando puoi spiegare semplicemente il problema in un solo post ...