Macro que genere un listado de los ficheros de un directorio con subcarpetas
Necesito una macro que genere un listado de los ficheros de un directorio con subcarpetas
La columna G de mi hoja de excel contiene nombres base (sin extensión) de ficheros.
Ejemplos de Nombre base de fichero en la hoja de excel:
Ploimext exmasic
Tengo una carpeta "C:\Ficheros\", que en sus más de cien subcarpetas "\A2X, \B3K, \EDX, \FD2,..." incluye algunos de estos ficheros, pero cuyos nombres tienen la peculiaridad que tienen añadido un sufijo de éstos "_002, _003, _004 ó _005" más la extensión ".wpd".
En la hoja de excel están sin sufijo ni extensión, sólo el nombre.
Ejemplo de ficheros en directorio:
C:\Ficheros\A2X\ploimext_002.wpd
C:\Ficheros\A2X\ploimext_003.wpd
C:\Ficheros\EDX\ploimext_004.wpd
C:\Ficheros\A5F\exmasic_002.wpd
La macro que necesito debería recorrer la columna G desde la celda G2 y comprobar si el fichero WPD cuyo nombre está en esa celda existe en alguna de las subcarpetas de C:\Ficheros, y si existe con sufijo 002, deberá colocar el nombre con el sufijo (sin extensión) en la celda H2, si encuentra el que tiene sufijo 003 a la I2, si encuentra el que tiene sufijo 004 a la J2, y por último si encuentra el que tiene el sufijo 005 en la K2
Así recorriendo toda la columna G2 hasta el final de la misma.
Adjunto una imagen delo que podría ser el resultado de la ejecución de la macro.
1 Respuesta
H o l a:
Te anexo la macro
Sub GenerarListado()
'Por.Dante Amor
Application.DisplayAlerts = False
ActiveSheet.UsedRange.Offset(1, 7).ClearContents
Set ruta = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Ficheros\")
For i = 2 To Range("G" & Rows.Count).End(xlUp).Row
col = 8
For Each subcarpeta In ruta.SubFolders
arch = Dir(subcarpeta & "\" & Cells(i, "G") & "*.wpd")
Do While arch <> ""
Cells(i, col) = Replace(arch, ".wpd", "")
col = col + 1
arch = Dir()
Loop
Next
Next
MsgBox
Gracias por tu respuesta...
Adapté tu macro a mis directorios y rula casi ok. Sólo se me olvidó decir en la petición que a la hora de comparar los nombres, ignore para el listado los propios nombres sin sufijo, ya que los ficheros del tipo Ploimext.wpd exmasic.wpd también están en los directorios, y si los tiene en cuenta al compararlos duplica en el listado, ya que están en la columna G2.
Te mando un correo con mis directorios (un par de ellos, claro) y la macro para que puedas apreciar lo que te explico.
Porque sé que lo conseguirás, te valoro ya ...
Te anexo la macro actualizada
Sub GenerarListado()
'Por.Dante Amor
Application.DisplayAlerts = False
ActiveSheet.UsedRange.Offset(1, 7).ClearContents
Set ruta = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Ficheros\")
For i = 2 To Range("G" & Rows.Count).End(xlUp).Row
col = 8
For Each subcarpeta In ruta.SubFolders
arch = Dir(subcarpeta & "\" & Cells(i, "G") & "*.wpd")
Do While arch <> ""
archivo = Replace(arch, ".wpd", "")
If archivo <> Cells(i, "G") Then
Cells(i, col) = archivo
col = col + 1
End If
arch = Dir()
Loop
Next
Next
MsgBox "Listado Generado", vbInformation, "MACRO GENEAR LISTADO"
End Sub
