从 pdf URL 中提取 pdf 属性

Question

我有一组 4000 个 pdf url，需要提取文档属性，例如文档创建日期、文档大小、页数。

注意：不应下载 PDF 文档。

请给我一个建议。

问候， 阿拉文

Answer 1

嗯...我正在写一点并在互联网上搜索解决方案...

没有找到不下载文件的解决方案，觉得不可能。

但是我做了一个代码来下载文件，获取它的属性，然后删除它。对用户完全透明。

如何使用： 任何细胞类型 =GetPDFData(URL;NumberData)

例如： =getPDFData(A2;1)

数字数据：

1 = 名称

2 = 创建日期

3 = 修改日期

4 = PageCount（是“测试版”，有时不起作用哈哈）

5 = 大小

6 = 种类

还有代码：（将其粘贴到新模块中）

Public Function GetPDFData(URL As String, TipoDato As Integer) As String

    Dim oFS As Object
    Dim strFilename As String
    CreateFolder
    DownloadFile (URL)
    strFilename = "C:\Temp\pdfTemporal\" & NombreDeArchivo(URL)
    Set oFS = CreateObject("Scripting.FileSystemObject")
    Select Case TipoDato
        Case 1
        GetPDFData = NombreDeArchivo(URL)
        Case 2
        GetPDFData = oFS.GetFile(strFilename).DateCreated
        Case 3
        GetPDFData = oFS.GetFile(strFilename).DateLastModified
        Case 4
        GetPDFData = pagecount(strFilename)
        Case 5
        GetPDFData = oFS.GetFile(strFilename).Size / 1024 & "Kb"
        Case 6
        GetPDFData = oFS.GetFile(strFilename).Type
        Case Else
        GetPDFData = "ERROR"
    End Select
    Set oFS = Nothing
    DeleteFolder

End Function

Sub DownloadFile(myURL As String)

    Dim TextUrl As String
    TextUrl = myURL
    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", myURL, False
    WinHttpReq.send
    myURL = WinHttpReq.responseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile "c:\Temp\pdfTemporal\" & NombreDeArchivo(TextUrl), 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    End If

End Sub

Sub CreateFolder()
    Dim Path As String, NombreCarpeta As String
    Path = "c:\Temp\"
    NombreCarpeta = "pdfTemporal"
     If Dir(Path, vbDirectory) <> "" Then
       If Dir(Path & NombreCarpeta, vbDirectory) = "" Then MkDir Path & NombreCarpeta
     End If
End Sub

Sub DeleteFolder()
    On Error Resume Next
     Kill "c:\Temp\pdfTemporal\*.*"
    RmDir "c:\Temp\pdfTemporal\"
    On Error GoTo 0
End Sub

Public Function NombreDeArchivo(URL As String) As String

Dim a As String
Dim esp As String
esp = " "
a = URL
For i = 1 To 500
 esp = esp & " "
Next i
a = Replace(a, "/", esp)
a = Right(a, 500)
a = Trim(a)
NombreDeArchivo = a

End Function

Public Function pagecount(sfilename As String) As String
Dim pages As Long
On Error GoTo a
Dim nFileNum As Integer
Dim s As String
Dim c As Integer
Dim pos, pos1 As Integer
pos = 0
pos1 = 0
c = 0
nFileNum = FreeFile
Open sfilename For Binary Lock Read Write As #nFileNum

  Do Until EOF(nFileNum)
    Input #1, s
    c = c + 1
    If c <= 10 Then
        pos = InStr(s, "/N")
    End If
    pos1 = InStr(s, "/count")
       If pos > 0 Or pos1 > 0 Then
            Close #nFileNum
            s = Trim(Mid(s, pos, 10))
            s = Replace(s, "/N", "")
            s = Replace(s, "/count", "")
            s = Replace(s, " ", "")
            s = Replace(s, "/", "")
            For i = 65 To 125
                    s = Replace(s, Chr(i), "")
            Next
            pages = Val(Trim(s))
            If pages < 0 Then
                pages = 1
            End If
            Close #nFileNum
            pagecount = pages
            Exit Function
        End If
        If c >= 10000 Then
             GoTo a
        End If
  Loop
    Close #nFileNum
    pagecount = pages
    Exit Function
a:
    Close #nFileNum
    pages = 1
    pagecount = pages
    Exit Function
End Function

我希望你觉得它有用，或者至少是一个开始

您好！