web-dev-qa-db-ja.com

PDFからデータを抽出してワークシートに追加

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
excelvbapdf
8
Will Bell

PDFファイルを開き、Adobeライブラリを使用してその内容を抽出できます（SDKの一部としてAdobeからダウンロードできますが、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

これが行うことは、基本的にあなたがやろうとしているのと同じことです-アドビ独自のライブラリのみを使用します。 PDF一度に1ページを通過し、ページ上のすべてのテキストを強調表示してから、一度に1つのテキスト要素）を文字列にドロップします。

これから得られるものはすべての種類の非印刷文字（ラインフィード、改行など）でいっぱいになる可能性があることに注意してください。使用する前にクリーンアップします。

お役に立てば幸いです！

11
leowyn

私はこれが古い問題であることを知っていますが、私は仕事中のプロジェクトのためにこれをしなければなりませんでした、そして私は誰もまだこの解決策について考えていないことに非常に驚いています：Microsoft Wordで.pdfを開いてください。

このコードは、Microsoft Wordで開くため、.docxからデータを抽出しようとする場合の作業がはるかに簡単です。 ExcelとWordは、どちらもMicrosoftプログラムであるため、うまく連携します。私の場合、質問のファイルhadは.pdfファイルになります。ここに私が思いついた解決策があります：

  1. .pdfファイルを開いてMicrosoft Wordにするデフォルトのプログラムを選択します
  2. Wordで初めて.pdfファイルを開くと、Wordで.pdfを.docxファイルに変換する必要があることを示すダイアログボックスが表示されます。 「このメッセージを今後表示しない」という左下のチェックボックスをクリックし、[OK]をクリックします。
  3. .docxファイルからデータを抽出するマクロを作成します。 MikeD's Code をこのリソースとして使用しました。
  4. MoveDown、MoveRight、およびFind.Executeメソッドをいじって、タスクのニーズに合わせます。

はい、.pdfファイルを.docxファイルに変換することもできますが、これは私の意見でははるかに簡単なソリューションです。

3
expodavid

ユーザーインタラクションエミュレーションによるコピーと貼り付けは、信頼できない場合があります（たとえば、ポップアップが表示され、フォーカスが切り替わります）。コマーシャルを試すことに興味があるかもしれません ByteScout PDF Extractor SDK これは、PDF VBA。 VBコード を使用して、請求書および表からCSVとしてデータを抽出することもできます。

指定された場所からテキストを抽出し、Sheet1のセルに保存するExcelのVBAコードを次に示します。

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に関連しています

1
Eugene

時間が経つにつれて、構造化された形式でPDFからテキストを抽出するのは難しいビジネスであることがわかりました。ただし、簡単なソリューションを探している場合は、 [〜＃〜] xpdf [〜＃〜] ツールpdftotextを検討することをお勧めします。

テキストを抽出するための擬似コードには次のものが含まれます。

  1. Shell VBAステートメントを使用して、 [〜＃〜] xpdf [〜＃〜] を使用してPDFから一時ファイルにテキストを抽出します
  2. 順次ファイル読み取りステートメントを使用して、一時ファイルの内容を文字列に読み取ります
  3. 文字列を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
1
RIBH

私は外部ライブラリや他のプログラムに依存することを好まないため、ソリューションが機能するように拡張しました。ここでの実際の変更は、Pasteの代わりにGetFromClipboard関数を使用することです主に、一連のセルを貼り付けるために使用されます。もちろん、欠点はユーザーがプロセス全体でフォーカスを変更したり介入したりしてはならないことです。

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 でご覧ください。

0
Slinky Sloth

スリンキーナマケモノの解決策を改善するには、クリップボードから取得する前にこれを追加する必要がありました：

Set objPDF = New MSForms.DataObject

残念なことに、10ページのpdfでは機能しませんでした。

0
eugene michaux

Bytescout PDF Extractor SDK を使用することは良いオプションです。安価で、多くのPDF関連機能を提供します。答えの1つです。上記はGitHubのBytescoutのデッドページを指しています。PDFからテーブルを抽出するための関連作業サンプルを提供しています。

Set extractor = CreateObject("Bytescout.PDFExtractor.StructuredExtractor")

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

' Load sample PDF document
extractor.LoadDocumentFromFile "../../sample3.pdf"

For ipage = 0 To extractor.GetPageCount() - 1 

    ' starting extraction from page #"
    extractor.PrepareStructure ipage

    rowCount = extractor.GetRowCount(ipage)

    For row = 0 To rowCount - 1 
        columnCount = extractor.GetColumnCount(ipage, row)

        For col = 0 To columnCount-1
            WScript.Echo "Cell at page #" +CStr(ipage) + ", row=" & CStr(row) & ", column=" & _
                CStr(col) & vbCRLF & extractor.GetCellValue(ipage, row, col)
        Next
    Next
Next

さらに多くのサンプルが利用可能です： https://github.com/bytescout/pdf-extractor-sdk-samples

0
AbhishekTripathi