VBA Копирование данных из pdf

Question

У меня есть большое количество PDF-файлов, из которых я хотел бы скопировать все данные в файл в столбец в электронной таблице.

Вот код, который был у меня. Все, что он делает, это открыть pdf, использовать control-a, затем control-c для копирования, затем активирует рабочую книгу, находит открытый столбец и вставляет данные с помощью элемента управления-v Sendkey. Он отлично работает, но он только вставляет последние данные из самого последнего файла (у меня есть диапазон с именами путей, которые он открывает, и копирует данные из всех, но только фактически вставляет последний).

Sub StartAdobe1() 

    Dim AdobeApp As String 
    Dim AdobeFile As String 
    Dim StartAdobe 
    Dim fname As Variant 
    Dim iRow As Integer 
    Dim Filename As String 

For Each fname In Range("path") 

    AdobeApp = "C:\Program Files (x86)\Adobe\Reader 10.0\Reader\AcroRd32.exe" 
    StartAdobe = Shell("" & AdobeApp & " " & fname & "", 1) 


    Application.Wait Now + TimeValue("00:00:01") 
    SendKeys "^a", True 
    Application.Wait Now + TimeValue("00:00:01") 
    SendKeys "^c" 
    Application.Wait Now + TimeValue("00:00:01") 
    SendKeys ("%{F4}") 
    Windows("transfer (Autosaved).xlsm").Activate 
    Worksheets("new").Activate 


    ActiveSheet.Range("A1").Select 
    Selection.End(xlToRight).Offset(0, 1).Select 

    SendKeys "^v" 
    Application.Wait Now + TimeValue("00:00:2") 

Next fname 

Answer 1

Я совсем не могу получить код для работы, но я думаю, что это копирование всех данных, но перезаписывать его каждый раз через петлю. Чтобы исправить эту попытку:.

ActiveSheet.Cells(1, ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1).Select 

вместо двух строк, которые начинаются ActiveSheet.Range («A1») Выбрать и Selection.End ....

Answer 2

право Jeanno, в если у вас есть Acrobat, то с помощью его библиотека API для работы с файлом напрямую намного лучше, чем обходные пути. Я использую это каждый день для преобразования файлов PDF в записи базы данных.

У вашего кода есть несколько проблем, но я подозреваю, что самая большая проблема заключается в использовании SendKeys "^v" для вставки в Excel. Вам лучше выбрать ячейку, которую вы хотите, используя Selection.Paste. Или, что еще лучше, перенесите содержимое буфера обмена в переменную, а затем проанализируйте его по мере необходимости на бэкэнде перед тем, как писать в свою электронную таблицу, но это добавляет кучу сложности и в этом случае не поможет вам.

Чтобы использовать приведенный ниже код, обязательно выберите «Библиотека типов Acrobat x.x» в разделе «Инструменты»> «Ссылки».

Sub StartAdobe1() 
    Dim fName  As Variant 
    Dim wbTransfer As Excel.Workbook 
    Dim wsNew  As Excel.Worksheet 
    Dim dOpenCol As Double 
    Dim oPDFApp  As AcroApp 
    Dim oAVDoc  As AcroAVDoc 
    Dim oPDDoc  As AcroPDDoc 

    'Define your spreadsheet 
    Set wbTransfer = Workbooks("transfer (Autosaved).xlsm") 
    Set wsNew = wbTransfer.Sheets("new") 
    'Find first open column 
    dOpenCol = ws.Cells(1, columns.count).End(xlToleft).Column + 1 

    'Instantiate Acrobat Objects 
    Set oPDFApp = CreateObject("AcroExch.App") 
    Set oAVDoc = CreateObject("AcroExch.AVDoc") 
    Set oPDDoc = CreateObject("AcroExch.PDDoc") 

For Each fName In Range("path") 

    'Open the PDF file. The AcroAVDoc.Open function returns a true/false 
    'to tell you if it worked 
    If oAVDoc.Open(fName.Text, "") = True Then 
     Set oPDDoc = oAVDoc.GetPDDoc 
    Else 
     Debug.Assert False 
    End If 

    'Copy all using Acrobat menu 
    oPDFApp.MenuItemExecute ("SelectAll") 
    oPDFApp.MenuItemExecute ("Copy") 

    'Paste into open column 
    wbTransfer.Activate 
    wsNew.Cells(1, dOpenCol).Select 
    ActiveSheet.Paste 

    'Select next open column 
    dOpenCol = dOpenCol + 1 

    oAVDoc.Close (1) '(1)=Do not save changes 
    oPDDoc.Close 

Next 

    'Clean up 
    Set wbTransfer = Nothing 
    Set wsNew = Nothing 
    Set oPDFApp = Nothing 
    Set oAVDoc = Nothing 
    Set oPDDoc = Nothing 


End Sub 

Примечание: 1-Существует также пункт меню oPDFApp.MenuItemExecute ("CopyFileToClipboard"), который должен сделать выбор все и скопировать в один шаг, но у меня были проблемы с ним, поэтому я придерживаться метода двухступенчатой ​​выше.

2-A pdf-файл состоит из двух объектов: oAVDoc и oPDDoc. Различные аспекты файла контролируются каждым. В этом случае вам может понадобиться только oAVDoc. Попробуйте прокомментировать строки, касающиеся oPDDoc, и посмотрите, работает ли это без них.

Answer 3

попробовать этот код это может работать:

Sub Shell_Copy_Paste() 

    Dim o As Variant 
    Dim wkSheet As Worksheet 

    Set wkSheet = ActiveSheet 

    o = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe C:\Users\saurabh.ad.sharma\Desktop\red.pdf", vbNormalFocus) 

    Application.Wait (Now + TimeSerial(0, 0, 2)) 'Wait for Acrobat to load 

    SendKeys "^a" 'Select All 
    SendKeys "^c" 'Copy 
    SendKeys "%{F4}" 'Close shell application 

    wkSheet.Range("B5").Select 
    SendKeys "^v" 'Paste 

End Sub 

Answer 4

НИЖЕ код будет копировать данные из PDF & Вставиться В СЛОВЕ THEN копирования данных из WORD И ТОГДА вставить его в EXCEL.

ТЕПЕРЬ Почему я копирую данные из pdf в word &, затем копируя их из слова и вставляя его в excel, потому что я хочу, чтобы данные из pdf в точном формате были на моем листе excel, если я копирую непосредственно из pdf, чтобы это было вставьте все данные из pdf в одну ячейку, даже если у меня есть два столбца или несколько строк, они будут вставлять все мои данные в один столбец, и это тоже в одной ячейке, но если я копирую из слова, чтобы преуспеть, он сохранит его оригинал формат и два столбца будут вставлены как два столбца только в excel.

Private Sub CommandButton3_Click() '(load pdf) 


    Dim o As Variant 
Set appWord = CreateObject("Word.Application") 
o = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe C:\Users\saurabh.ad.sharma\Desktop\Book1.pdf", vbNormalFocus) 'loading adobe reader & pdf file from their location 
Application.Wait (Now + TimeSerial(0, 0, 2)) 
    SendKeys ("^a") 
SendKeys ("^c") 
SendKeys "%{F4}" 
Application.Wait Now + TimeValue("00:00:01") 
Set appWord = CreateObject("Word.Application") 
appWord.Visible = True 
appWord.Documents.Add.Content.Paste 
With appWord 

     .ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & "\pdf" & ".docx", FileFormat:=wdocument 'saving word file in docx format 
     .ActiveWindow.Close 
     .Quit 
    End With 

MsgBox " pdf is loaded " 
MsgBox " Paste to EXCEL " 

    Set appWord = CreateObject("Word.Application") 
    appWord.Visible = True 

    appWord.Documents.Open "C:\Users\saurabh.ad.sharma\Desktop\pdf.docx" 'opening word document 
     appWord.Selection.WholeStory 
     appWord.Selection.Copy 
    Set wkSheet = ActiveSheet 
    wkSheet.Range("A1").Select 
    wkSheet.Paste 'pasting to the excel file 

End Sub 

Answer 5

Это более модифицированная версия моего кода выше не будет сохранить любой документ, он будет сохранять данные в буфер обмена и сделать выполнение быстро ..

Private Sub CommandButton3_Click() '(load pdf) 


    Dim o As Variant 
Set appWord = CreateObject("Word.Application") 
o = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe C:\Users\saurabh.ad.sharma\Desktop\Book1.pdf2", vbNormalFocus) 
Application.Wait (Now + TimeSerial(0, 0, 2)) 
    SendKeys ("^a") 
SendKeys ("^c") 
SendKeys "%{F4}" 
Application.Wait Now + TimeValue("00:00:01") 
Set appWord = CreateObject("Word.Application") 
appWord.Visible = False 
appWord.Documents.Add.Content.Paste 
With appWord 

     .Selection.WholeStory 
     .Selection.Copy 
     .ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges 
     .Quit 
End With 

MsgBox " pdf is loaded " 
MsgBox " Paste to EXCEL " 


    Set wkSheet = ActiveSheet 
    wkSheet.Range("A1").Select 
    wkSheet.Paste 

End Sub