Excel 从pdf URL提取pdf属性

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

注意：不应下载PDF文档

请给我一个建议

问候,，

---

阿拉文德

嗯。。。我写了一点东西，在互联网上寻找解决这个问题的方法

没有下载文件的解决方案找不到，并且认为不可能

但我编写了一个代码，下载文件，获取其属性，然后删除它。所有这些都对用户完全透明

如何使用： 任何细胞类型 =GetPDFData（URL；NumberData）

例如： =getPDFData（A2；1）

数字数据：

1=名称

2=已创建日期

3=日期修改

4=页面计数（是“Beta”，有时不工作lol）

5=尺寸

6=种类

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

公共函数GetPDFData（URL为字符串，TipoDato为整数）为字符串
作为对象的模糊oFS
将strFilename设置为字符串
创建文件夹
下载文件（URL）
strFilename=“C:\Temp\pdfTemporal\”&NombreDeArchivo（URL）
Set of s=CreateObject（“Scripting.FileSystemObject”）
选择案例TipoDato
案例1
GetPDFData=NombreDeArchivo（URL）
案例2
GetPDFData=oFS.GetFile（strFilename）.DateCreated
案例3
GetPDFData=oFS.GetFile（strFilename）.DateLastModified
案例4
GetPDFData=pagecount（strFilename）
案例5
GetPDFData=oFS.GetFile（strFilename）.Size/1024&“Kb”
案例6
GetPDFData=oFS.GetFile（strFilename）。键入
其他情况
GetPDFData=“错误”
结束选择
集合=无
删除文件夹
端函数
子下载文件（myURL作为字符串）
模糊纹理如字符串
TextUrl=myURL
Dim WinHttpReq作为对象
设置WinHttpReq=CreateObject（“Microsoft.XMLHTTP”）
WinHttpReq.Open“GET”，myURL，False
WinHttpReq.send
myURL=WinHttpReq.ResponseBy
如果WinHttpReq.Status=200，则
设置oStream=CreateObject（“ADODB.Stream”）
奥斯特雷姆，开门
oStream.Type=1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile“c:\Temp\pdfTemporal\”和NombreDeArchivo（TextUrl），2'1=不覆盖，2=覆盖
奥斯特雷姆，完毕
如果结束
端接头
子文件夹（）
Dim路径作为字符串，NOMBERCARPETA作为字符串
Path=“c:\Temp\”
NombreCarpeta=“pdfTemporal”
如果Dir（Path，vbDirectory）“，则
如果Dir（Path&NombreCarpeta，vbDirectory）=“”，则MkDir Path&NombreCarpeta
如果结束
端接头
子文件夹（）
出错时继续下一步
终止“c:\Temp\pdfTemporal\*.*”
RmDir“c:\Temp\pdfTemporal\”
错误转到0
端接头
公共函数NombreDeArchivo（URL作为字符串）作为字符串
像线一样变暗
以字符串的形式显示
esp=“”
a=URL
对于i=1到500
esp=esp&“
接下来我
a=替换（a，“/”，esp）
a=右（a，500）
a=修剪（a）
NombreDeArchivo=a
端函数
公共函数pagecount（sfilename作为字符串）作为字符串
使页面变暗，变长
关于错误转到a
作为整数的Dim nFileNum
像线一样变暗
作为整数的Dim c
Dim pos，pos1为整数
pos=0
pos1=0
c=0
nFileNum=FreeFile
打开二进制锁读写为#nFileNum的sfilename
直到EOF为止（nFileNum）
输入#1，s
c=c+1
如果c0或pos1>0，则
关闭#nFileNum
s=饰件（中部（s，位置10））
s=替换（s，“/N”，”）
s=替换（s，“/count”，“”）
s=替换（s，“，”）
s=替换（s，“/”，“”）
对于i=65到125
s=替换（s，Chr（i），“”）
下一个
页数=Val（修剪）
如果页面小于0，则
页数=1
如果结束
关闭#nFileNum
pagecount=页数
退出功能
如果结束
如果c>=10000，则
转到a
如果结束
环
关闭#nFileNum
pagecount=页数
退出功能
a:
关闭#nFileNum
页数=1
pagecount=页数
退出功能
端函数

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

---

你好

如果您不能在这些URL指向的服务器上使用软件，并且您不想下载PDF文件，您建议如何了解这些文件？我认为你在这里定义了一个物理上的不可能…如果有任何软件在那里，建议。所以我可以试一试。如果这在物理上是不可能的，谁能推荐软件呢？此外，关于Stackoverflow的软件建议是不允许的。我忘了澄清：这是excel的自定义功能！！尼古拉斯，谢谢你的工作。但是，文档创建日期和修改日期给出了错误的数据。它显示实际时间。有什么解决办法吗？

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