¿Cómo convertir o importar listado de archivos PDF a un listado de Excel?
Tengo una carpeta que contiene cientos de archivos en PDF y necesito importar todos los nombres de dichos archivos para presentarlos como un listado normal del Excel.
Por lo anterior, solicito su valiosa ayuda para importar con una macro todos los archivos PDF de una carpeta y convertirlos a un listado de Excel.
2 respuestas
'Autor del código: jrgces
Public Sub ListarPDFs()
Dim fsObject As Object, fsCarpeta As Object, fsArchivo As Object
Dim wksListado As Worksheet
Dim lFila As Long
Dim sCarpetaPDFs As String
sCarpetaPDFs = "C:\borrar" '<-- Poner la ruta donde estén los pdfs
Set wksListado = ThisWorkbook.Worksheets("Listado") '<-- Poner el nombre de la hoja donde se listarán los pdfs
lFila = 2 'Fila donde empezará el listado
Set fsObject = CreateObject("Scripting.FileSystemObject")
Set fsCarpeta = fsObject.GetFolder(sCarpetaPDFs)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With wksListado
.[A:B].ClearContents 'Se borrará lo que haya en las columnas A y B de wksListado
.[A1].Value = "Nombre"
.[B1].Value = "Fecha modificación"
End With
For Each fsArchivo In fsCarpeta.Files
If LCase(Right(fsArchivo.Name, 3)) = "pdf" Then
wksListado.Cells(lFila, 1).Value = fsArchivo.Name
wksListado.Cells(lFila, 2).Value = fsArchivo.DateLastModified
lFila = lFila + 1
End If
Next fsArchivo
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Set fsObject = Nothing
Set fsCarpeta = Nothing
Set fsArchivo = Nothing
Set wksListado = Nothing
End SubSaludos_
Excelente!, muchas gracias, es posible omitir la extensión del archivo?
Me temo que no entiendo la pregunta. Si se omite la extensión del archivo, es decir
If LCase(Right(fsArchivo.Name, 3)) = "pdf" Then
y el End If 4 filas más abajo, el código listará todo lo que haya en la carpeta.
Saludos_
Pensándolo mejor, si lo que necesitas es que en el listado no aparezcan las extensiones .pdf de los ficheros, puedes modificar la línea
wksListado.Cells(lFila, 1).Value = fsArchivo.Name
por
wksListado.Cells(lFila, 1).Value = fsObject.GetBaseName(fsArchivo.Name)
Saludos_
Debes explicar cómo se llama tu carpeta.
En cuál columna tienes los nombres de archivo y cuál columna quieres el resultado.
Prueba lo siguiente.
Supone que la carpeta se llama "c:\trabajo\pdfs\"
También supone que los nombres están en la columna A y que el resultado lo quieres en la columna B.
Sub Macro2()
Dim ruta As String
Dim img As Range
ruta = "C:\trabajo\pdfs\"
For Each img In Range("A2", Range("A" & Rows.Count).End(3))
If Dir(ruta & img.Value & ".pdf") <> "" Then
img.Offset(0, 1).Value = img.Value & ".pdf"
ActiveSheet.Hyperlinks.Add Anchor:=img.Offset(0, 1), _
Address:=ruta & img.Offset(0, 1).Value, TextToDisplay:=img.Offset(0, 1).Value
End If
Next
End Sub
Wooow!
¡Muchas gracias!
[