VBA读取PDF文件内容(字符级别读取)

bluesky_0

Private Sub CommandButton3_Click()
'读取PDF文件内容,不支持图片.仅支持源文件是文档文件转化为PDF的
sTime = Timer
'PDF_File As String
Dim AC_PD As New Acrobat.AcroPDDoc
Dim AC_Hi As Acrobat.AcroHiliteList
Dim AC_PG As Acrobat.AcroPDPage
Dim AC_PGTxt As Acrobat.AcroPDTextSelect

Dim WS_PDF As Worksheet
Dim RW_Ct As Long
Dim Col_Num As Integer
Dim Li_Row As Long
Dim Yes_Fir As Boolean

Dim Ct_Page As Long
Dim i As Long, j As Long, k As Long, ROW_DEL As Long
Dim T_Str As String

Dim Hld_Txt As Variant

'Application.ScreenUpdating = False
Set AC_PD = New Acrobat.AcroPDDoc 'PDF文件
Set AC_Hi = New Acrobat.AcroHiliteList 'PDF文本字符
AC_Hi.Add 0, 32767 '限制文本字符个数
With AC_PD
watermarkfile = ThisWorkbook.Path & "\" & Sheet1.Range("A" & 2) '需要操作的文件名
.Open watermarkfile '打开PDF文件
    Ct_Page = .GetNumPages '得到PDF文件页数
    If Ct_Page = -1 Then 'pdf文件页数不对
        MsgBox "请确认PDF文件 '" & PDF_File & "'"
        .Close
        Set WS_PDF = Nothing
        Set AC_PGTxt = Nothing
        Set AC_PG = Nothing
        Set AC_Hi = Nothing
        Set AC_PD = Nothing
    End If

ROW_DEL = Sheet2.Range("E62222").End(xlUp).Row
ROW_DEL = Application.WorksheetFunction.Max(ROW_DEL, 2)
Sheet2.Range("E2:G" & ROW_DEL).Clear '清除读取区域的旧数据
'MsgBox ROW_DEL
    For i = 1 To Ct_Page   '从PDF第一页 到最后一页
        T_Str = ""
        Set AC_PG = .AcquirePage(i - 1) '得到当前页
        Set AC_PGTxt = AC_PG.CreateWordHilite(AC_Hi) '得到当期文字列表

        If Not AC_PGTxt Is Nothing Then
            With AC_PGTxt
            III = .GetNumText
                For j = .GetNumText - 8 To .GetNumText - 1
                    T_Str = T_Str & .GetText(j) '获得文本
                Next j
            End With
        End If
             T_Str = Right(T_Str, 13)
                    Sheet2.Range("E" & i + 1).Value = T_Str
                    Sheet2.Range("F" & i + 1).Value = i
    Next i
    .Close
End With
'Sheet2.Range("G" & 2).Value = "=B2=E2"
'Sheet2.Range("G2:G" & i).FillDown

Application.ScreenUpdating = True

Set WS_PDF = Nothing
Set AC_PGTxt = Nothing
Set AC_PG = Nothing
Set AC_Hi = Nothing
Set AC_PD = Nothing

MsgBox "数据计算完毕!用时" & Round(Timer - sTime, 2) & "秒。" & Round((Timer - sTime) / 60, 4) & "分钟。"
End Sub

xlsm文件附件:

wengjl

一开始就出错。是什么问题？

bluesky_0

wengjl 发表于 2022-11-25 08:28
一开始就出错。是什么问题？

需要安装PDF程序,然后查看 VBA引用
我把xlsm文件发来,放在第一页

rrxfw

太牛了，厉害

gaozengxun

这研究研究

岷山沅水

bluesky_0 发表于 2022-11-25 08:44
需要安装PDF程序,然后查看 VBA引用
我把xlsm文件发来,放在第一页

大神，我安装了 Adobe Acrobat pro,为什么没有 Adobe Acrobat 10.0 type Libray?求解答

bluesky_0

岷山沅水 发表于 2023-10-7 22:02
大神，我安装了 Adobe Acrobat pro,为什么没有 Adobe Acrobat 10.0 type Libray?求解答

Adobe Acrobat XXX type Libray 和你安装的版本有关
xxx表示版本号

peter-chen

留个脚印学习，谢谢

goots

学习了！楼主这样处理PDF也太强大了！