Question

我正在尝试将PDF文档中的数据提取到工作表中。 PDF显示和文本可以手动复制并粘贴到Excel文档中。

我目前通过SendKeys执行此操作，但它无法正常工作。当我尝试粘贴PDF文档中的数据时出错。为什么我的粘贴不起作用？如果我在宏停止运行后粘贴，它会正常粘贴。

ServicePrincipalNames= "MSSQLSvc/${dbServerName}.${domainName}:1433", "MSSQLSvc/${dbServerName}:1433"

Answer 1

您可以使用Adobe库打开PDF文件并提取其内容（我相信您可以从Adobe下载作为SDK的一部分，但它也附带某些版本的Acrobat）

确保将库添加到您的引用中（在我的机器上，它是Adobe Acrobat 10.0类型库，但不确定这是否是最新版本）

即使使用Adobe库也不是一件容易的事（你需要添加自己的错误捕获等）：

Function getTextFromPDF(ByVal strFilename As String) As String
   Dim objAVDoc As New AcroAVDoc
   Dim objPDDoc As New AcroPDDoc
   Dim objPage As AcroPDPage
   Dim objSelection As AcroPDTextSelect
   Dim objHighlight As AcroHiliteList
   Dim pageNum As Long
   Dim strText As String

   strText = ""
   If (objAvDoc.Open(strFilename, "") Then
      Set objPDDoc = objAVDoc.GetPDDoc
      For pageNum = 0 To objPDDoc.GetNumPages() - 1
         Set objPage = objPDDoc.AcquirePage(pageNum)
         Set objHighlight = New AcroHiliteList
         objHighlight.Add 0, 10000 ' Adjust this up if it's not getting all the text on the page
         Set objSelection = objPage.CreatePageHilite(objHighlight)

         If Not objSelection Is Nothing Then
            For tCount = 0 To objSelection.GetNumText - 1
               strText = strText & objSelection.GetText(tCount)
            Next tCount
         End If
      Next pageNum
      objAVDoc.Close 1
   End If

   getTextFromPDF = strText

End Function

这样做基本上与您尝试做的事情相同 - 仅使用Adobe自己的库。它一次浏览PDF一页，突出显示页面上的所有文本，然后将其删除（一次一个文本元素）到字符串中。

请记住，从中获得的内容可能包含各种非打印字符（换行符，换行符等），这些字符甚至可能最终会出现在连续的文本块中间，因此您可以在使用它之前需要额外的代码来清理它。

希望有所帮助！

Answer 2

我知道这是一个老问题，但是我只是在工作的一个项目中要做，我很惊讶没有人想到这个解决方案： 只需用Microsoft word打开.pdf。

当您尝试从.docx提取数据时，该代码更容易使用，因为它在Microsoft Word中打开。 Excel和Word一起很好地发挥了作用，因为它们都是Microsoft程序。就我而言，问题文件必须是.pdf文件。这是我想出的解决方案：

选择默认程序以将.pdf文件打开为Microsoft Word
第一次使用word打开.pdf文件时，会弹出一个对话框，要求您将word转换为.docx文件。单击左下方指出“不再显示此消息”的复选框，然后单击“确定”。
创建一个宏，该宏从.docx文件中提取数据。我使用MikeD's Code作为此资源。
修补一下MoveDown，MoveRight和Find.Execute方法，以满足您的任务需求。

是的，您可以将.pdf文件转换为.docx文件，但是我认为这是一个更简单的解决方案。

Answer 3

随着时间的推移，我发现以结构化格式从PDF中提取文本是一项艰巨的任务。但是，如果您正在寻找一个简单的解决方案，您可能需要考虑XPDF工具pdftotext。

提取文本的伪代码包括：

使用SHELL VBA语句使用XPDF
使用顺序文件读取语句将临时文件内容读入字符串
将字符串粘贴到Excel

以下简化示例：

    Sub ReadIntoExcel(PDFName As String)
        'Convert PDF to text
        Shell "C:\Utils\pdftotext.exe -layout " & PDFName & " tempfile.txt"

        'Read in the text file and write to Excel
        Dim TextLine as String
        Dim RowNumber as Integer
        Dim F1 as Integer
        RowNumber = 1
        F1 = Freefile()
        Open "tempfile.txt" for Input as #F1
            While Not EOF(#F1)
                Line Input #F1, TextLine
                ThisWorkbook.WorkSheets(1).Cells(RowNumber, 1).Value = TextLine
                RowNumber = RowNumber + 1
            Wend
        Close #F1
    End Sub

Answer 4

通过用户交互仿真进行复制和粘贴可能不可靠（例如，弹出窗口会切换焦点）。您可能有兴趣尝试专门设计用于从PDF中提取数据的广告ByteScout PDF Extractor SDK，它可以在VBA中运行。它还能够使用VB code以CSV格式从发票和表格中提取数据。

以下是Excel的VBA代码，用于从给定位置提取文本并将其保存到Sheet1中的单元格中：

Private Sub CommandButton1_Click()

' Create TextExtractor object
' Set extractor = CreateObject("Bytescout.PDFExtractor.TextExtractor")
Dim extractor As New Bytescout_PDFExtractor.TextExtractor

extractor.RegistrationName = "demo"
extractor.RegistrationKey = "demo"

' Load sample PDF document
extractor.LoadDocumentFromFile ("c:\sample1.pdf")

' Get page count
pageCount = extractor.GetPageCount()

Dim wb As Workbook
Dim ws As Worksheet
Dim TxtRng  As Range

Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")

For i = 0 To pageCount - 1
            RectLeft = 10
            RectTop = 10
            RectWidth = 100
            RectHeight = 100

            ' check the same text is extracted from returned coordinates
            extractor.SetExtractionArea RectLeft, RectTop, RectWidth, RectHeight
            ' extract text from given area
            extractedText = extractor.GetTextFromPage(i)

            ' insert rows
            ' Rows(1).Insert shift:=xlShiftDown
            ' write cell value
             Set TxtRng = ws.Range("A" & CStr(i + 2))
             TxtRng.Value = extractedText

Next

Set extractor = Nothing


End Sub

披露：我与ByteScout

有关

Answer 5

使用Bytescout PDF Extractor SDK是个不错的选择。它很便宜并且提供了大量与PDF相关的功能。上面的答案之一指向GitHub上的死页Bytescout。我提供了一个相关的工作样本来从PDF中提取表格。您可以使用它以任何格式导出。

PctRank = (COUNTA(Table6[Name])-Table6[Rank])/(COUNTA(Table6[Name])-1)

此处提供了更多示例：https://github.com/bytescout/pdf-extractor-sdk-samples

Answer 6

由于我不喜欢依赖外部库和/或其他程序，因此我扩展了您的解决方案，使其可以工作。此处的实际更改是使用 GetFromClipboard 函数而不是 Paste （主要用于粘贴一系列单元格）。当然，缺点是用户在整个过程中不得改变焦点或进行干预。

Dim pathPDF As String, textPDF As String
Dim openPDF As Object
Dim objPDF As MsForms.DataObject

pathPDF = "C:\some\path\data.pdf"
Set openPDF = CreateObject("Shell.Application")
openPDF.Open (pathPDF)
'TIME TO WAIT BEFORE/AFTER COPY AND PASTE SENDKEYS
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^a"
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^c"
Application.Wait Now + TimeValue("00:00:1")

AppActivate ActiveWorkbook.Windows(1).Caption
objPDF.GetFromClipboard
textPDF = objPDF.GetText(1)
MsgBox textPDF

如果您有兴趣，请在github中查看我的项目。

Answer 7

要改善Slinky Sloth的解决方案，我必须先从剪贴板添加此内容：

Set objPDF = New MSForms.DataObject

可悲的是，它对10页的pdf无效。

Answer 8

这似乎不适用于Adobe Type库。一旦打开，我会收到429错误。 Acrobat可以正常工作...

从PDF中提取数据并添加到工作表

8 个答案: