VBA: cómo generar una carpeta o directorio

Tiempo atrás me llegó una consulta de un usuario donde me pedía que comprobara un código en VBA cuya finalidad era crear una carpeta:

...Tenemos un código para crear una carpeta si no existe y da error. La verdad que es la primera vez que me enfrento a esto porque el error que da no tiene sentido:
Set DIRECTORIO_COMPLETO = CreateObject("Scripting.FileSystemObject")
If Not DIRECTORIO_COMPLETO.FolderExists(RUTA_COMPLETA) Then
DIRECTORIO_COMPLETO.CreateFolder (RUTA_COMPLETA)
End If
El error lo da el create folder ya que dice que no puede encontrar la ruta. Sin embargo la ruta existe (Excepto el final)
La RUTA_COMPLETA es algo asi como 'C:\PEDRO\15254\' Existe C:\PEDRO y debería crear 15254.
¿Está mal el código? (Es que en otras versiones si funcina, grrrr)...

Existen varias formas de crear carpetas/directorios e incluso archivos, una es la que planteaba el lector; sin embargo yo voy a explicar una distinta que genera menos errores. Se trata de emplear la función VBA Dir y la instrucción MkDir.
Plantearé un ejemplo sencillo con una macro donde hemos definido las variables necsarias, tales como la ruta o Path donde crear el directorio y el nombre que asignaremos a la carpeta o NombreCarpeta:

Nuestro código VBA a incluir en un módulo del Explorador del proyecto dentro del Editor de VBA es:

Sub GenerarCarpeta()
Dim Path As String, NombreCarpeta As String

Path = "C:\"
NombreCarpeta = "Archivos\Nueva"
'Verificamos si la carpeta existe ya...
If Dir(Path, vbDirectory) <> "" Then
'Comprueba que la carpeta no existe para crearla.
If Dir(Path & NombreCarpeta, vbDirectory) = "" Then MkDir Path & NombreCarpeta
'MkDir se emplea para crear un directorio/carpeta.
'Si no se especifica la unidad de disco, el directorio/carpeta se crea en la unidad actual.
End If

End Sub

Si ejecutamos dicha macro 'GenerarCarpeta comprobaremos como se crea dicho directorio en la ruta definida, así como el subdirectorio; igualmente si ya estuviera generado el primer nivel de directorio (que he llamado 'Archivos') añade el subdirectorio correspondiente.

9 comentarios:

RICARDO QUIRQUEmayo 16, 2011
Hola soy nuevo en esto de compartir información en un blog desde ya mis disculpas si no soy lo suficientemente prolijo.
Me quedé con la creación de una carpeta y encontré que una posible dificultad que habría sería que si el usuario tuviera la unidad del sistema con otra letra diferente a la “C” adiós al código, nos daría un error.
Pense en subsanarlo mediante una verificación previa de cuáles son las letras asignadas a las unidades lógicas usando algunas funciones de Windows.

Una de ellas es la función GetLogicalDriveStrings

Declare Function GetLogicalDriveStrings Lib "Kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Sub ObtenerUnidadesLogicas()
Dim Texto As String
Dim Longitud As Long
Dim CadenaResultante As Long
Dim i As Integer
'Inicializamos las variables
Texto = String(255, 0) 'Generamos una cadena de 255 caracteres de valor nulo
Longitud = Len(Texto)
CadenaResultante = GetLogicalDriveStrings(Longitud, Texto)
'CadenaResultante = Devuelve el numero de caracteres no vacíos. Cero en caso de error.

Texto = Left(Texto, CadenaResultante) 'Truncamos la cadena al valor de CadenaResultante eliminando así los caracteres vacíos a la derecha de texto
Debug.Print Texto
For i = 1 To CadenaResultante Step 4
Debug.Print Mid(Texto, i, 3)
Next i

End Sub

Otra posible solución sería preguntarle a Windows cuál es su directorio, el cual ya tendría asignada la letra correspondiente.

Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" _
(ByVal f As String, ByVal fLen As Long) As Long

Sub DirectorioWindows()
Dim DirWin As String
Dim TamañoDevuelto As Long

'Generamos una cadena de 255 caracteres de valor nulo para que la función
deposite el valor del directorio de windows
DirWin = String(255, 0)

'Llamado a la función GetWindowsDirectory para obtener información del directorio.
'TamañoDevuelto=longitud de la cadena devuelta por la DLL
'DirWin=cadena con el directorio de windows

TamañoDevuelto = GetWindowsDirectory(DirWin, Len(DirWin))

'Ajustamos la cadena al tamaño devuelto
DirWin = Left(DirWin, TamañoDevuelto)
Debug.Print DirWin
End Sub

La función retornará: >> C:\WINDOWS
Recortamos la cadena y ya está.
ResponderEliminar
Respuestas
Excelforo - Ismael Romeromayo 17, 2011
Muchas gracias Ricardo por compartirlo...
desde luego todas las colaboraciones son bienvenidas... por mi parte lo revisaré y aprenderé todo lo que pueda de tu código.
Un saludo
ResponderEliminar
Respuestas
Rodrigofebrero 01, 2012
hola, he tratado de hacer que esta macro aparte de crear una carpeta con el nombre de la celda especificada, me genere un hipervinculo al interior de la carpeta creada. no se que poner en address...

Sub Crear_carpetas()
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
ruta = "C:\Documents and Settings\rodrigo.sims\Escritorio\Ficha Proveedor\Base Datos (Hipervinculos)\Proveedores"
Range("A10").Select

If Not fso.FolderExists(ruta & "\" & ActiveCell.Value) Then
fso.CreateFolder (ruta & "\" & ActiveCell.Value)
End If

ActiveSheet.Hyperlinks.Add _
Anchor:=Range("B10"), _
Address:="C:\Documents and Settings\rodrigo.sims\Escritorio\Ficha Proveedor\Base Datos (Hipervinculos)\Proveedores\", _
TextToDisplay:="Documentos del Proveedor", _
ScreenTip:="Enlace a Carpeta Proveedor"

Set fso = Nothing

Application.ScreenUpdating = True
End Sub

ojala me puedan ayudar me tiene super complicado esto, saludos
ResponderEliminar
Respuestas
Ing Gonzalo Reyesabril 19, 2016
Me pueden apoyar con este codigo, el cual me marca un error de "Error 70, Permiso Denegador"
le muestro el codigo a continuacion

Private Sub CommandButton2_Click()
Dim objFSO
Dim objTF
Dim i As Integer
Dim Nombre, Archivo As String
Nombre = InputBox("Ingrese Nombre del Archivo a Generar")
Set objFSO = CreateObject("scripting.filesystemobject")
' 'create a txt file
Set objTF = objFSO.CreateTextFile("F:\" & Nombre & ".txt", True)

Open "F:\" & Nombre & ".txt" For Output As #1
For i = 0 To ListBox1.ListCount
Print #1, ListBox1.List(i)
Next i
Close #1
End Sub

Y revice la seguridad del archivo y no tiene ningun problema para abrirlo manual, pero al querer abrirlo por el codigo no me deja, me aparece el error de permiso denegado.

Gracias cualquier aporte es bien venido
saludos a todos.
ResponderEliminar
Respuestas