Sub leer_pdf_unico_archivo()

'Selección directa de archivos PDF

Dim xStr As String
Dim row As Integer
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object

Set xFd = Application.FileDialog(msoFileDialogFilePicker)
Set fso = CreateObject("Scripting.FileSystemObject")

If xFd.Show = -1 Then

'Permitimos multiselección

row = 9
xFd.AllowMultiSelect = True
Range("B" & row & ":F100").ClearContents

For Each vrtSelectedItem In xFd.SelectedItems

extension = fso.GetExtensionName(vrtSelectedItem)
xFdItem = vrtSelectedItem
xStr = ""

'Buscamos archivos PDF y mediante la función adicionar_link los añadimos al listado

If (extension = "pdf") Then

Range("B" & row).Value = xFdItem
Call adicionar_link("B" & row, CStr(xFdItem))

'Calculamos el número de páginas

Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile

Open (xFdItem) For Binary As #xFileNum

xStr = Space(LOF(xFileNum))
Get #xFileNum, , xStr

Close #xFileNum

Range("C" & row).Value = RegExp.Execute(xStr).Count

'Buscamos archivos DOC/DOCx y mediante la función adicionar_link los añadimos al listado

ElseIf (extension = "doc" Or extension = "docx") Then

Range("B" & row).Value = xFdItem
Call adicionar_link("B" & row, CStr(xFdItem))

'Calculamos el número de páginas

Range("C" & row).Value = "Loading..."
Set xWdApp = CreateObject("Word.Application")
Set xWd = GetObject(vrtSelectedItem)
Range("C" & row).Value = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Close False

End If

row = row + 1

Next

End If

End Sub

Sub leer_pdf_desde_carpeta()

'Selección de carpeta y lectura de todos los PDF incluidos

Dim xStr As String
Dim row As Integer
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Set fso = CreateObject("Scripting.FileSystemObject")

If xFd.Show = -1 Then

row = 9
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.*", vbDirectory)
xStr = ""
Range("B" & row & ":F100").ClearContents

Do While xFileName <> ""

extension = fso.GetExtensionName(xFileName)

'Leemos los archivos PDF

If (extension = "pdf") Then

Range("E" & row).Value = xFdItem & xFileName
Call adicionar_link("E" & row, xFdItem & xFileName)

'Calculamos el número de páginas

Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile

Open (xFdItem & xFileName) For Binary As #xFileNum

xStr = Space(LOF(xFileNum))
Get #xFileNum, , xStr

Close #xFileNum

Range("F" & row).Value = RegExp.Execute(xStr).Count
row = row + 1

'Leemos los archivos DOC/DOCx

ElseIf (extension = "doc" Or extension = "docx") Then

Range("E" & row).Value = xFdItem & xFileName
Call adicionar_link("E" & row, xFdItem & xFileName)

'Calculamos el número de páginas

Range("F" & row).Value = "Loading..."
Set xWdApp = CreateObject("Word.Application")
Set xWd = GetObject(xFdItem & xFileName)
Range("F" & row).Value = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Close False
row = row + 1

End If

xFileName = Dir

Loop

End If

End Sub

Private Sub adicionar_link(celda As String, archivo As String)

'Función para añadir links

With Range(celda)

.Hyperlinks.Add Anchor:=Range(celda), Address:=archivo

End With

End Sub