Sub CreateDirs(MyDirName)
    Set objFSO = CreateObject( "Scripting.FileSystemObject" )
    ' Получение полного пути, если задан относительный (из текущего каталога)
    strDir = objFSO.GetAbsolutePathName(MyDirName)
    ' Разбивка пути на составляющие
    arrDirs = Split(strDir, "\")
    ' Проверка, это UNC-путь, или нет
    ' strDirBuild - начальный каталог, с которого начнётся создание каталогов
    If Left(strDir, 2) = "\\" Then
        strDirBuild = "\\" & arrDirs(2) & "\" & arrDirs(3) & "\"
        idxFirst    = 4
    Else
        strDirBuild = arrDirs(0) & "\"
        idxFirst    = 1
    End If
    ' Создание каталогов
    For i = idxFirst to Ubound(arrDirs)
        strDirBuild = objFSO.BuildPath(strDirBuild, arrDirs(i))
        If Not objFSO.FolderExists(strDirBuild) Then
            objFSO.CreateFolder strDirBuild
        End if
    Next
    Set objFSO= Nothing
End Sub

' CreateDirs "C:\temp\_temp1\_temp2\_temp3"
' CreateDirs "\\CompName\c$\temp\_temp1\_temp2\_temp3"