Podemos crear una macro que genera un listado de 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.
- ARCHIVOS EN LA RAÍZ CON RUTA
Sub Archivos_Raiz_Ruta()
Application.ScreenUpdating = False
Set fs_objeto = 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 = fs_objeto.GetFolder(ruta)
Set ficheros = directorio.Files
Range("A1").Select
ActiveCell = "Archivos"
ActiveCell.Font.Bold = True
ActiveCell.Font.Underline = xlUnderlineStyleSingle
Range("A2").Select
For Each archivo In ficheros
ActiveCell = ruta & archivo.Name
ActiveCell.Offset(1, 0).Select
Next
Set fs_objeto = Nothing
Set directorio = Nothing
Set ficheros = Nothing
Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Ejecutar la macro
Verificar como muestra la lista de archivos situadas en la raíz de la unidad, mostrando la ruta.
- ARCHIVOS EN LA RAÍZ SIN RUTA
Sub Carpetas_Raiz()
Application.ScreenUpdating = False
Set fs_objeto = 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 = fs_objeto.GetFolder(ruta)
Set ficheros = directorio.Files
Range("A1").Select
ActiveCell = "Archivos"
ActiveCell.Font.Bold = True
ActiveCell.Font.Underline = xlUnderlineStyleSingle
Range("A2").Select
For Each archivo In ficheros
ActiveCell = archivo.Name
ActiveCell.Offset(1, 0).Select
Next
Set fs_objeto = Nothing
Set directorio = Nothing
Set ficheros = Nothing
Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Ejecutar la macro
Verificar como muestra la lista de carpetas situadas en la raíz de la unidad, sin mostrar la ruta.
- TODOS LOS ARCHIVOS SIN RUTA
Sub Archivos_Todos()
Application.ScreenUpdating = False
Dim datosCarpeta As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Seleccionar la carpeta"
.Show
If .SelectedItems.Count > 0 Then
datosCarpeta = .SelectedItems(1) & "\"
End If
End With
With ActiveSheet
.Cells(1, 1) = "Archivos"
.Cells(1, 1).Font.Bold = True
End With
Call LoopFolders(datosCarpeta)
End Sub
Sub LoopFolders (strFolderPath As String)
Dim objFileSystem As Object
Dim objFolder As Object
Dim objFile As Object
Dim nLastRow As Integer
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder(strFolderPath)
For Each objFile In objFolder.Files
With ActiveSheet
nLastRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & nLastRow) = objFile.Name
End With
Next
If objFolder.subfolders.Count > 0 Then
For Each objSubFolder In objFolder.subfolders
If ((objSubFolder.Attributes And 2) = 0) And ((objSubFolder.Attributes And 4) = 0) Then
LoopFolders (objSubFolder.Path)
End If
Next
End If
Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Ejecutar la macro
Verificar como muestra la lista de todas las carpetas, sin mostrando la ruta.
- TODOS LOS ARCHIVOS CON RUTA
Sub Archivo_todos_Ruta()
Application.ScreenUpdating = False
Dim datosCarpeta As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Seleccionar la carpeta"
.Show
If .SelectedItems.Count > 0 Then
datosCarpeta = .SelectedItems(1) & "\"
End If
End With
With ActiveSheet
.Cells(1, 1) = "Archivos"
.Cells(1, 1).Font.Bold = True
End With
Call LoopFolders(datosCarpeta)
End Sub
Sub LoopFolders (strFolderPathAs String)
Dim objFileSystem As Object
Dim objFolder As Object
Dim objFile As Object
Dim nLastRow As Integer
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder(strFolderPath)
For Each objFile In objFolder.Files
With ActiveSheet
nLastRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & nLastRow) = objFile.Path
End With
Next
If objFolder.subfolders.Count > 0 Then
For Each objSubFolder In objFolder.subfolders
If ((objSubFolder.Attributes And 2) = 0) And ((objSubFolder.Attributes And 4) = 0) Then
LoopFolders (objSubFolder.Path)
End If
Next
End If
Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Ejecutar la macro
Verificar como muestra la lista de todas las carpetas, mostrando la ruta.
- TODOS LOS ARCHIVOS CON HIPERVÍNCULO
Sub Archivos_ruta_link()
Dim fs_objeto As Object
Dim directorio As String
Dim dir_Archivo As Variant
Set dir_Archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_Archivo.Show
If dir_Archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
With ActiveSheet
.Cells(1, 1) = "Archivos"
.Cells(1, 1).Font.Bold = True
End With
directorio = dir_Archivo.SelectedItems(1)
Set fs_objeto = CreateObject("Scripting.FileSystemObject")
Carpeta fs_objeto.GetFolder(directorio)
End Sub
Function Carpeta(ByVal nCarpeta)
Dim j As Long
Dim Subcarpeta As Object
With ActiveSheet
For Each Subcarpeta In nCarpeta.subfolders
Carpeta Subcarpeta
Next
j = Application.CountA(.Range("A:A")) + 1
For Each file In nCarpeta.Files
.Cells(j, 1).Select
.Hyperlinks.Add Anchor:=Selection, Address:=file.Path, TextToDisplay:=file.Path
j = j + 1
Next
End With
Columns("A:A").EntireColumn.AutoFit
End Function
Ejecutar la macro
Verificar como muestra la lista de archivos con hipervínculo.
- ARCHIVOS PROPIEDADES
Sub Archivos_propiedades()
Dim strWindowsFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Seleccionar la carpeta"
.Show
If .SelectedItems.Count > 0 Then
strWindowsFolder = .SelectedItems(1) & "\"
End If
End With
With ActiveSheet
.Cells(1, 1) = "Nombre"
.Cells(1, 1).Font.Bold = True
.Cells(1, 2) = "Ruta"
.Cells(1, 2).Font.Bold = True
.Cells(1, 3) = "Tamaño"
.Cells(1, 3).Font.Bold = True
.Cells(1, 4) = "Tipo Archivo"
.Cells(1, 4).Font.Bold = True
.Cells(1, 5) = "Fecha creación"
.Cells(1, 5).Font.Bold = True
End With
Call LoopFolders(strWindowsFolder)
End Sub
Sub LoopFolders(strFolderPath As String)
Dim objFileSystem As Object
Dim objFolder As Object
Dim objFile As Object
Dim nLastRow As Integer
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder(strFolderPath)
For Each objFile In objFolder.Files
With ActiveSheet
nLastRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & nLastRow) = objFile.Name
.Range("B" & nLastRow) = objFile.Path
.Range("C" & nLastRow) = objFile.Size
.Range("D" & nLastRow) = objFile.Type
.Range("E" & nLastRow) = objFile.datecreated
.Columns("A:E").AutoFit
End With
Next
If objFolder.subfolders.Count > 0 Then
For Each objSubFolder In objFolder.subfolders
If ((objSubFolder.Attributes And 2) = 0) And ((objSubFolder.Attributes And 4) = 0) Then
LoopFolders (objSubFolder.Path)
End If
Next
End If
End Sub
Ejecutar la macro
Verificar como muestra la lista de archivos con las propiedades en columna (nombre, ruta, tamaño, tipo y fecha creación.
- ARCHIVOS FILTRADOS POR EXTENSIÓN
Sub Archivo_Extensión()
Application.ScreenUpdating = False
Dim ruta, archivos As String
Dim i As Integer
ruta = MiRuta2
archivos = Dir(ruta & "\*.xls*")
ActiveSheet.Range("A2:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row) = ""
i = 2
Do While Len(archivos) > 0
ActiveSheet.Cells(i, 1) = archivos
archivos = Dir()
i = i + 1
Loop
Range("A1").Select
ActiveCell = "Archivos Excel"
ActiveCell.Font.Bold = True
ActiveCell.Font.Underline = xlUnderlineStyleSingle
Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Function MiRuta2()
Dim directorio As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Seleccionar Carpeta"
.Show
directorio = .SelectedItems(1)
End With
If directorio <> "" Then
MiRuta2 = directorio
End If
End Function
archivos = Dir(ruta & "\*.xls*"). Indica la extensión deseada.
Ejecutar la macro
Verificar como muestra la lista de archivos con la extensión deseada, en el ejemplo .xls* para Excel.
Excel Experto VBA - Macros