Enumere los detalles de todos los archivos dentro de una carpeta usando VBA en Microsoft Excel

Anonim

En este artículo, crearemos una macro para recopilar detalles de todos los archivos dentro de una carpeta.

Antes de ejecutar la macro, debemos especificar la ruta de la carpeta en el cuadro de texto.

Al ejecutar la macro, devolverá el nombre del archivo, la ruta del archivo, el tamaño del archivo, la fecha de creación y la fecha de la última modificación de todos los archivos dentro de la carpeta.

Explicación lógica

En este artículo, hemos creado dos macros "ListFilesInFolder" y "TestListFilesInFolder".

La macro "ListFilesInFolder" mostrará detalles relacionados con todos los archivos dentro de la carpeta.

La macro "TestListFilesInFolder" se utiliza para especificar el encabezado y llamar a la macro "ListFilesInFolder".

Explicación del código

Establecer FSO = CreateObject ("Scripting.FileSystemObject")

El código anterior se utiliza para crear un nuevo objeto de sistema de archivos.

Establecer SourceFolder = FSO.GetFolder (SourceFolderName)

El código anterior se utiliza para crear un objeto de la carpeta especificada por la ruta.

Celdas (r, 1) .Fórmula = FileItem.Name

Celdas (r, 2) .Fórmula = FileItem.Path

Celdas (r, 3) .Fórmula = FileItem.Size

Celdas (r, 4) .Fórmula = FileItem.DateCreated

Celdas (r, 5) .Fórmula = FileItem.DateLastModified

El código anterior se utiliza para extraer detalles de los archivos.

Para cada subcarpeta de SourceFolder.SubFolders

'Llamar al mismo procedimiento para subcarpetas

ListFilesInFolder SubFolder.Path, True

Siguiente subcarpeta

El código anterior se usa para extraer detalles de todos los archivos dentro de las subcarpetas.

Columnas ("A: E"). Seleccione

Selection.ClearContents

El código anterior se utiliza para eliminar contenido de la columna A a la E.

Siga a continuación para obtener el código

 Option Sub ListFilesInFolder explícito (ByVal SourceFolderName como cadena, ByVal incluyen subcarpetas como booleano) 'Declarando variables Dim FSO como objeto Dim SourceFolder como objeto Dim Subcarpeta como objeto Dim FileItem como objeto Dim r As Long' Creando objeto de FileSystemObject Set FSO = CreateObject ("Scripting .FileSystemObject ") Establecer SourceFolder = FSO.GetFolder (SourceFolderName) r = Range (" A65536 "). End (xlUp) .Row + 1 para cada elemento de archivo en SourceFolder.Files 'Mostrar propiedades de archivo Cells (r, 1) .Formula = FileItem.Name Cells (r, 2) .Formula = FileItem.Path Cells (r, 3) .Formula = FileItem.Size Cells (r, 4) .Formula = FileItem.DateCreated Cells (r, 5) .Formula = FileItem. DateLastModified r = r + 1 Next FileItem 'Obteniendo archivos en subcarpetas si IncluirSubfolders Luego para cada subcarpeta en SourceFolder.SubFolders' Llamando al mismo procedimiento para subcarpetas ListFilesInFolder SubFolder.Path, True Siguiente subcarpeta End If Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nada ActiveWorkbook.Saved = Verdadero End Sub Sub TestListFilesInFolder () 'Declarando variable Dim FolderPath como cadena' Deshabilitando las actualizaciones de pantalla Application.ScreenUpdating = False 'Obteniendo la ruta de la carpeta desde el cuadro de texto FolderPath = Sheet1.TextBox1.Value ActiveSheet.Activate' Borrando el contenido de las columnas A: E Columnas ("A: E"). Seleccione Selection.ClearContents 'Agregar encabezados Rango ("A14"). Fórmula = "Nombre de archivo:" Rango ("B14"). Fórmula = "Ruta:" Rango ("C14"). Fórmula = "Tamaño de archivo:" Rango ("D14"). Fórmula = "Fecha de creación:" Rango ("E14"). Fórmula = "Fecha de última modificación:" 'Formato de los encabezados Rango ("A14: E14"). Fuente .Negrita = True 'Llamando a la macro ListFilesInFolder ListFilesInFolder FolderPath, True' Ajuste automático del tamaño de las columnas Columns ("A: E"). Seleccione Selection.Columns.AutoFit Range ("A1"). Seleccione End Sub 

Si te gustó este blog, compártelo con tus amigos en Facebook. Además, puede seguirnos en Twitter y Facebook.

Nos encantaría saber de usted, háganos saber cómo podemos mejorar nuestro trabajo y hacerlo mejor para usted. Escríbanos al sitio de correo electrónico