Saltar al contenido

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.

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:\Directorio1\Subcarpeta1\Subcarpeta2\"
If Not oFSO.FolderExists(saveFolder) Then
  CreateDirs saveFolder
End If
End Sub

 

Leer entrada anterior
VBScript - Guarda los archivos adjuntos dentro de la carpeta del Remitente catalogado con fecha
VBScript – Guarda los archivos adjuntos dentro de la carpeta del Remitente catalogado con fecha

El siguiente VBScript es una variante de los publicados en el articulo "VBScript para guardar automáticamente archivos adjuntos Outlook." Este...

Cerrar