VBScript – Crear Directorio y subcarpetas recursivamente

El siguiente código es algo que requerí investigar un poco ya que me tope que VBScript no tiene la capacidad de crear el directorio principal y sub carpetas con la instrucción CreateFolder Ejemplo Incorrecto:

Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
DirectorioCompleto = "C:Directorio1Subcarpeta1Subcarpeta2"
oFSO.CreateFolder DirectorioCompleto

Para crear el directorio completo “C:Directorio1Subcarpeta1Subcarpeta2” se deben crear las carpetas una a una en el cual podremos utilizar la siguiente función.

Código Función Crear Directorio y Subcarpetas

Sub CreateDirs(MyFullPath)

    Dim arrDirs, i, idxFirst, objFSO, strDir, strDirBuild
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strDir = objFSO.GetAbsolutePathName(MyFullPath)
    arrDirs = Split(strDir, "")

    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

Ejemplo como enviar a llamar la función

Public Sub Prueba ()
Dim saveFolder As String
saveFolder = "C:Directorio1Subcarpeta1Subcarpeta2"
If Not oFSO.FolderExists(saveFolder) Then
  CreateDirs saveFolder
End If
End Sub