Lista los archivos en una carpeta con VBA en Microsoft Excel
En este artículo, crearemos una macro para enumerar todos los archivos dentro de la carpeta.
Al ejecutar la macro, el nombre del archivo junto con la ruta del archivo se mostrarán a partir de la celda A17.
Explicación lógica
En este artículo hemos creado dos macros, «subfolder_files» y «Getting_filelist_in_folder».
La macro «subfolder_files» toma la ruta de la carpeta y el valor booleano como entradas y devuelve el nombre del archivo dentro de la carpeta.
«Getting_filelist_in_folder» se utiliza para llamar a la macro «subfolder_files». Proporciona el valor de la ruta de la carpeta a la macro, con el valor booleano establecido en ‘verdadero’. Además, cuando se requieren nombres de archivo dentro de las subcarpetas, asignamos el valor booleano ‘verdadero’.
Explicación del código
folder_path = Sheet1.TextBox1.Value El código anterior se utiliza para extraer el valor de cadena del cuadro de texto.
Llamar a subfolder_files (folder_path, True)
El código anterior se utiliza para llamar a la macro «subfolder_files». Asigna la ruta de la carpeta y establece la propiedad «include_subfolder» como verdadera.
Establecer fso = CreateObject («scripting.filesystemobject»)
El código anterior se utiliza para crear un objeto del sistema de archivos.
Establecer subcarpeta1 = fso.getfolder (ruta_carpeta)
El código anterior se utiliza para crear el objeto de la carpeta definida.
Para cada carpeta1 En subfolder1.subfolders Llame a subfolder_files (folder1, True)
Siguiente El código anterior se utiliza para examinar todas las subcarpetas, dentro de la carpeta principal.
Dir (ruta de carpeta1 & «* .xlsx»)
El código anterior se usa para obtener el nombre del archivo de Excel.
Mientras que el nombre de archivo <> «»
count1 = count1 + 1 ReDim Preserve filearray (1 para contar1)
matriz de archivos (cuenta1) = nombre de archivo nombre de archivo = Dir ()
Wend El código anterior se utiliza para crear una matriz, que consta de todos los nombres de archivo presentes dentro de la carpeta.
Para i = 1 a UBound (matriz de archivos)
Celdas (lastrow, 1) .Value = folderpath1 & filearray (i)
lastrow = lastrow + 1 Siguiente El código anterior se usa para asignar un nombre de archivo dentro de la matriz al libro de trabajo.
Siga a continuación el código
Option Explicit
Sub subfolder_files(folderpath1 As Variant, Optional include_subfolder As Boolean)
'Checking whether to include subfolder or not
If include_subfolder Then
'Declaring variables
Dim filename, filearray() As String
Dim lastrow, count1, i As Integer
'Checking whether folder path contain backslash as last character
If Right(folderpath1, 1) <> "\" Then
folderpath1 = folderpath1 & "\"
End If
'Getting the filename of the first file in the defined folder path
filename = Dir(folderpath1 & "*.xlsx")
'Getting the row number of last cell
lastrow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row + 1
count1 = 0
'Looping through all the files in the folder
While filename <> ""
count1 = count1 + 1
ReDim Preserve filearray(1 To count1)
filearray(count1) = filename
filename = Dir()
Wend
On Error GoTo last
'Adding file name to workbook
For i = 1 To UBound(filearray)
Cells(lastrow, 1).Value = folderpath1 & filearray(i)
lastrow = lastrow + 1
Next
End If
last:
End Sub
Sub getting_filelist_in_folder()
'Declaring variables
Dim folder_path As String
Dim fso As Object, folder1, subfolder1 As Object
'Getting path of the folder
folder_path = Sheet1.TextBox1.Value
'Checking whether folder path contain backslash as last character
If Right(folder_path, 1) <> "\" Then
folder_path = folder_path & "\"
End If
'Calling subfolder_files macro
Call subfolder_files(folder_path, True)
'Creating object of File system object
Set fso = CreateObject("scripting.filesystemobject")
Set subfolder1 = fso.getfolder(folder_path)
'Looping through each subfolder
For Each folder1 In subfolder1.subfolders
Call subfolder_files(folder1, True)
Next
End Sub
Si te gustó este blog, compártelo con tus amigos en Facebook y Facebook.
Nos encantaría saber de usted, háganos saber cómo podemos mejorar nuestro trabajo y hacerlo mejor para usted. Escríbanos a [email protected]