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

Wil*_*ell 8 pdf excel vba

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

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

Dim myPath As String, myExt As String
Dim ws As Worksheet
Dim openPDF As Object
'Dim pasteData As MSForms.DataObject
Dim fCell As Range

'Set pasteData = New MSForms.DataObject
Set ws = Sheets("DATA")
If ws.Cells(ws.Rows.Count, "A").End(xlUp).Row > 1 Then Range("A3:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).ClearContents

myExt = "\*.pdf"
'When Scan Receipts Button Pressed Scan the selected folder/s for receipts
For Each fCell In Range(ws.Cells(1, 1), ws.Cells(1, ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column))
    myPath = Dir(fCell.Value & myExt)
    Do While myPath <> ""
        myPath = fCell.Value & "\" & myPath
        Set openPDF = CreateObject("Shell.Application")
        openPDF.Open (myPath)
        Application.Wait Now + TimeValue("00:00:2")
        SendKeys "^a"
        Application.Wait Now + TimeValue("00:00:2")
        SendKeys "^c"
        'Application.Wait Now + TimeValue("00:00:2")
        ws.Select
        ActiveSheet.Paste
        'pasteData.GetFromClipboard

        'ws.Cells(3, 1) = pasteData.GetText
        Exit Sub

        myPath = Dir
    Loop

Next fCell
Run Code Online (Sandbox Code Playgroud)

小智 11

您可以使用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
Run Code Online (Sandbox Code Playgroud)

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

请记住,从中获得的内容可能包含各种非打印字符(换行符,换行符等),这些字符甚至可能最终会出现在连续的文本块中间,因此您可能需要其他代码在使用它之前清理它.

希望有所帮助!

  • 很棒的答案!在我的Excel设置中,我必须添加一个称为“ Adob​​e”的参考库才能使其正常工作。顺便说一句,您在`If(obj(AvAvDoc.Open(strFilename,“”))'行上有一个错字。应该是'If(objAvDoc.Open(strFilename,“”)))。如果使用`Option Explicit` (应该如此),您还需要将此行添加到变量块中:`Dim tCount As Long`。感谢@leowyn提供此资源! (2认同)

小智 7

我知道这是一个老问题,但我只需要为工作中的项目执行此操作,我很惊讶还没有人想到此解决方案: 只需使用 Microsoft Word 打开 .pdf。

当您尝试从 .docx 中提取数据时,该代码更易于使用,因为它在 Microsoft Word 中打开。Excel 和 Word 可以很好地配合使用,因为它们都是 Microsoft 程序。在我的情况下,问题的文件必须是.pdf文件。这是我想出的解决方案:

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

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