Estructura de carpetas desde VBA

Necesito crear una rutina en VBA, desde la cual pueda crear una estructura de carpetas compleja, como la muestro en la imagen:

He estado investigando en algunos sitios, y existen codigos para crear carpetas y subcarpetas, pero hay que teclear la ruta de la estructura, es decir, si yo quiero crear la carpeta Logos, debe teclear toda su ruta para crearla; por otra parte, solo crea la estructura de carpetas que se escribe.

¿Existe alguna forma eficiente de realizar esta tarea?

1 Respuesta

Respuesta
1

Raul: Te doy el código para crear una y tu lo extiendes a lo que necesitas.

Este Código crea la Carpeta InformesPDF en la Carpeta que esté la Aplicación.

'*******
'Necesita la Referencia Microsoft Scripting Runtime >> C:\Windows\SysWOW64\scrrun.dll

Dim ExisteCarpeta As Boolean
Dim Dir As FileSystemObject
RutaApp = Application.CurrentProject.Path

Set Dir = New FileSystemObject

'Establezco True o False según si Existe o nó la Carpeta
ExisteCarpeta = Dir.FolderExists(Application.CurrentProject.Path & "\InformesPDF\") 'para comprobar si existe

'Sondeo el valor de ExisteCarpeta
If ExisteCarpeta = False Then
Dir.CreateFolder (Application.CurrentProject.Path & "\InformesPDF\") 'Para crear un directorio
MsgBox "Se ha creado la Carpeta \InformesPDF\ en el Directorio de la Aplicación!!!", vbExclamation, "CREACION DE CARPETA"
End If

Set Dir = Nothing
'********

El directorio CurrentProject. Path debes adaptarlo así como el resto.

Saludos >> Jacinto

Raul: Mirate por favor el comentario que ha hecho Sveinbjorn, ya que mi respuesta si no estás trabajando con VBA, Windows 64 no es del todo correcta. Saludos >> Jacinto

Gracias por la pronta respuesta y a Sveinbjorn El Rojo por el comentario. Ahora, si yo quiero hacer un programa que cree la estructura de carpetas que muestra la imagen; para crear la carpeta Logos, tendría algo como esto:

mkdir "C:\00 - PROJECT STRUCTURE"
mkdir "C:\00 - PROJECT STRUCTURE\External References"
mkdir "C:\00 - PROJECT STRUCTURE\External References\Images"
mkdir "C:\00 - PROJECT STRUCTURE\External References\Images\Logos"

¿Es decir, un linea de codigo por cada carpeta a crear?

Gracias y saludos.

De cada una Carpeta que vayas a crear, necesitas la Referencia de la anterior. O sea que si. Saludos >> Jacinto

Raul: se me ha olvidado comentarte, que te puedes crear una variable y vas acumulando su valor:

Dim Directorio As String

Directorio = "C:\00 - PROJECT STRUCTURE"

MkDir Directorio

Directorio = Directorio & "\External References"

MkDir Directorio

... y así sucesivamente. Algo te ahorras de escribir. Saludos >> Jacinto

¡Gracias! nuevamente por todo, lo resolví de la siguiente manera: 

Sub Structure()
Dim RootProject As String
Dim FirstLevel(1 To 6) As String
Dim SecondLevel(1 To 16) As String
Dim ThirdLevel(1) As String
Dim i As Integer
Dim j As Integer
    FirstLevel(1) = "Documents"
    FirstLevel(2) = "External References"
    FirstLevel(3) = "Production Drawings"
    FirstLevel(4) = "Reports"
    FirstLevel(5) = "Source Drawings"
    FirstLevel(6) = "Tools"
    SecondLevel(1) = "DGN"
    SecondLevel(2) = "DWF"
    SecondLevel(3) = "DWG"
    SecondLevel(4) = "Images"
    SecondLevel(5) = "PDF"
    SecondLevel(6) = "Alignments"
    SecondLevel(7) = "Pipe Networks"
    SecondLevel(8) = "Pressure Networks"
    SecondLevel(9) = "Surfaces"
    SecondLevel(10) = "Survey"
    SecondLevel(11) = "View Frame Groups"
    SecondLevel(12) = "As-built"
    SecondLevel(13) = "Plats"
    SecondLevel(14) = "Standards"
    SecondLevel(15) = "Utilities"
    ThirdLevel(1) = "Logos"
    RootProject = InputBox("New Project", "Create new project structure")
    MkDir "X:\" & RootProject
    For i = 1 To 6
        MkDir "X:\" & RootProject & "\" & FirstLevel(i)
    Next i
    For i = 1 To 6
        If i = 2 Then
            For j = 1 To 5
                MkDir "X:\" & RootProject & "\" & FirstLevel(i) & "\" & SecondLevel(j)
            Next j
        ElseIf i = 5 Then
            For j = 6 To 11
                MkDir "X:\" & RootProject & "\" & FirstLevel(i) & "\" & SecondLevel(j)
            Next j
        ElseIf i = 6 Then
            For j = 12 To 15
                MkDir "X:\" & RootProject & "\" & FirstLevel(i) & "\" & SecondLevel(j)
            Next j
        End If
    Next i
    MkDir "X:\" & RootProject & "\" & FirstLevel(2) & "\" & SecondLevel(4) & "\" & ThirdLevel(1)
End Sub

Y muy bien resuelto. Saludos >> Jacinto

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas