Podemos crear una macro que genera un listado de carpetas y archivos de una determinada ruta de nuestro equipo.
- CREAR MACRO
Con Excel abierto.
Pulsar la tecla Alt y mantener pulsada / Pulsar la tecla F11. Mostrará el editor de Visual Basic.
Ir a: Barra de Menú / Insertar / Módulo. Mostrará la ventana del módulo donde escribimos la macro.
Escribir el código de la macro...
Guardar el libro con la extensión *.xlsm. Libro habilitado para macros.
- CARPETAS Y ARCHIVOS EN LA RAÍZ DE LA UNIDAD
Sub Carpetas_Archivos_Raiz()
On Error Resume Next
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Seleccionar la carpeta"
.Show
End With
On Error Resume Next
ruta = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Set Directorio = fso.GetFolder(ruta)
Set subdirectorios = Directorio.SubFolders
Set ficheros = Directorio.Files
Range("A1").Select
ActiveCell = "Carpetas"
ActiveCell.Font.Bold = True
ActiveCell.Font.Underline = xlUnderlineStyleSingle
ActiveCell.Offset(1, 0).Select
For Each subdirectorio In subdirectorios
ActiveCell = subdirectorio.Name
ActiveCell.Offset(1, 0).Select
Next
ActiveCell = "Archivos de Carpeta"
ActiveCell.Font.Bold = True
ActiveCell.Font.Underline = xlUnderlineStyleSingle
ActiveCell.Offset(1, 0).Select
For Each archivo In ficheros
ActiveCell = archivo.Name
ActiveCell.Offset(1, 0).Select
Next
Set fso = Nothing
Set Directorio = Nothing
Set subdirectorios = Nothing
Set ficheros = Nothing
Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Ejecutar la macro / Verificar como muestra la lista de las carpetas y los archivos situadas en la raíz de la unidad.
- TODAS LAS CARPETAS Y ARCHIVOS
Private Sub Todas_CarpetasArchivo()
Application.ScreenUpdating = False
Dim Shell, mi_path, strPath, i
i = 2
Set Shell = CreateObject("Shell.Application")
Set mi_path = Shell.BrowseForFolder(&O0, "Seleccionar la carpeta", &H1 + &H10, "")
If mi_path Is Nothing Then Exit Sub
strPath = mi_path.Items.Item.Path
Range("A" & i, ActiveCell.SpecialCells(xlLastCell)).ClearContents
mi_lista strPath, i
End Sub
Private Sub mi_lista(strPath, i)
Dim mi_hoja, objeto_Fs, objeto_Fld, objeto_Fl, objeto_Sb
Set objeto_Fs = CreateObject("Scripting.FileSystemObject")
Set objeto_Fld = objeto_Fs.GetFolder(strPath)
Set mi_hoja = ActiveSheet
Range("A1").Select
ActiveCell = "Carpeta"
ActiveCell.Font.Bold = True
ActiveCell.Font.Underline = xlUnderlineStyleSingle
Range("B1").Select
ActiveCell = "Archivo"
ActiveCell.Font.Bold = True
ActiveCell.Font.Underline = xlUnderlineStyleSingle
For Each objeto_Fl In objeto_Fld.Files
mi_hoja.Cells(i, 1) = objeto_Fl.ParentFolder.Path
mi_hoja.Cells(i, 2) = objeto_Fs.GetFileName(objeto_Fl.Path)
i = i + 1
Next
For Each objeto_Sb In objeto_Fld.SubFolders
mi_lista objeto_Sb.Path, i
Next
Columns("A:B").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Ejecutar la macro / Verificar como muestra la lista de todas las carpetas y todos los archivos situadas en dos columnas
Excel Experto VBA - Macros