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:\Directorio1\Subcarpeta1\Subcarpeta2\"
oFSO.CreateFolder DirectorioCompleto

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

[adinserter name=”Articulo 2″]

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

[adinserter name=”Articulo 1″]
Public Sub Prueba ()
Dim saveFolder As String
saveFolder = "C:\Directorio1\Subcarpeta1\Subcarpeta2\"
If Not oFSO.FolderExists(saveFolder) Then
  CreateDirs saveFolder
End If
End Sub

 

¿Te sirvio?, Ayudanos calificando el articulo:

Lecturas recomendadas…