How to copy data from pdf to excel using VBA for multiple sheets?

harikris2013 · May 7, 2014

Hi,

I have 200 sheets of data in PDF file which needs to copy to 200 sheets in excel workbook

I need to use only acrobat reader 5.

I have below macro which is copying only one and pasting to sheet1

Please modify the below macro

Sub StartAdobe()

Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe

AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 5.0\Reader\AcroRd32.exe"
AdobeFile = "C:\Users\Dell\Desktop\Dead Men Tell No Tales.pdf"

StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)

Application.OnTime Now + TimeValue("00:00:05"), "FirstStep"

End Sub

Private Sub FirstStep()

SendKeys ("^a")
SendKeys ("^c")

Application.OnTime Now + TimeValue("00:00:10"), "SecondStep"

End Sub

Private Sub SecondStep()

AppActivate "Microsoft Excel"

Range("A1").Activate
SendKeys ("^v")

End Sub

MHamid · Mar 5, 2018

Hello,

I stepped through the code and I see it deleting the sheet it creates. However, the file names are not the same and it should not be deleting them. These are the file names:
Audit Report - A234099 CS
Internal Audit Report – A
A110525 - Lane Archive Te
A289122 - Internal Audit
A19005 - Retail - Financi
A16806 - US Funds Transfe
Internal Audit - Direct C
A137855 Internal Audit Re
A170584 - Retail - Balanc

Now that I think about it, I don't need to delete the sheet anyways. I don't need to worry about duplication so I just commented that section out.
However, is there a way to name the sheet as A###### instead of the file name. The A###### is part of the file name and I don't really need the file name since it is very long and will be truncated. I just need it to look at the filename and name the sheet as A###### (could be 5 or 6 numbers after the letter A). Is this possible?

Thank you

join · Feb 18, 2023

sijpie said:
Are these 200 pages in one pdf, or 200 pdf files? I am assuming the latter although you write that it is only one file.

You need to loop through each of the files in a sub that then calls the startAdobe sub. But somewhere you will also want to close the pdf files.

Let's assume that all the pdf files are in one folder. The following will do the trick. I have used some of your code, but not the paste part, as we can use Excel's paste for that.

Read throuh the code (plus comments) and see what it does and how it differs from yours

Option Explicit Sub LoopThroughFiles() Dim strFile As String, strPath As String Dim colFiles As New Collection Dim i As Integer Dim rLog As Range, rOut As Range Dim wsLog As Worksheet, wsOutp As Worksheet strPath = "C:\TEMP\" strFile = Dir(strPath) ' Make a log sheet On Error Resume Next Set wsLog = Sheets("PdfProcessLog") On Error GoTo 0 If wsLog Is Nothing Then Set wsLog = ThisWorkbook.Sheets.Add(before:=Sheets(1)) wsLog.Name = "PdfProcessLog" End If Set rLog = wsLog.Range("A1") rLog.CurrentRegion.ClearContents rLog.Value = "PDF files copied to sheets" ' load all the files in a Collection While strFile <> "" If StrComp(Right(strFile, 3), "pdf", vbTextCompare) = 0 Then colFiles.Add strFile End If strFile = Dir Wend Application.DisplayAlerts = False 'Loop through the pdf's stored in the collection For i = 1 To colFiles.Count 'List filenames in Column A of the log sheet rLog.Offset(i, 0).Value = colFiles(i) strFile = Left(colFiles(i), Len(colFiles(i)) - 4) ' Delete sheet with filename if exists On Error Resume Next Set wsOutp = Sheets(strFile) On Error GoTo 0 If Not wsOutp Is Nothing Then wsOutp.Delete End If ' (Re)Create the worksheet, give it the file name Set wsOutp = ThisWorkbook.Sheets.Add(after:=wsLog) wsOutp.Name = strFile ' Now open the file, and copy contents OpenClosePDF colFiles(i), strPath CopyStep wsOutp Next i Application.DisplayAlerts = True End Sub Sub OpenClosePDF(ByVal sAdobeFile As String, ByVal sPath As String) Dim sAdobeApp As String Dim vStartAdobe As Variant sAdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 5.0\Reader\AcroRd32.exe" sAdobeApp = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe" vStartAdobe = Shell("" & sAdobeApp & " " & sPath & sAdobeFile & "", 1) Application.Wait (Now + TimeValue("0:00:01")) End Sub Private Sub CopyStep(wsOutp As Worksheet) ' select all & copy SendKeys "^a", True SendKeys "^c", True Application.Wait (Now + TimeValue("0:00:01")) ' Paste into the sheet from cell A1 wsOutp.Paste Cells(1, 1) Application.Wait (Now + TimeValue("0:00:01")) AppActivate "Adobe Reader" ' close Reader SendKeys "%{F4}", True End Sub

hi expert,
can you show the above code again ? as it is not clear, thank you.

sijpie · Feb 19, 2023

VBA Code:

Sub LoopThroughFiles()
    Dim strFile As String, strPath As String
    Dim colFiles As New Collection
    Dim i As Integer
    Dim rLog As Range, rOut As Range
    Dim wsLog As Worksheet, wsOutp As Worksheet
    
    strPath = "C:\TEMP\"
    strFile = Dir(strPath)
    ' Make a log sheet
    On Error Resume Next
    Set wsLog = Sheets("PdfProcessLog")
    On Error GoTo 0
    If wsLog Is Nothing Then
        Set wsLog = ThisWorkbook.Sheets.Add(before:=Sheets(1))
        wsLog.Name = "PdfProcessLog"
    End If
    Set rLog = wsLog.Range("A1")
    rLog.CurrentRegion.ClearContents
    rLog.Value = "PDF files copied to sheets"
    
    ' load all the files in a Collection
    While strFile  ""
        If StrComp(Right(strFile, 3), "pdf", vbTextCompare) = 0 Then
            colFiles.Add strFile
        End If
        strFile = Dir
    Wend
    
    Application.DisplayAlerts = False
    
    'Loop through the pdf's stored in the collection
    For i = 1 To colFiles.Count
        'List filenames in Column A of the log sheet
        rLog.Offset(i, 0).Value = colFiles(i)
        strFile = Left(colFiles(i), Len(colFiles(i)) - 4)
        
        ' Delete sheet with filename if exists
        On Error Resume Next
        Set wsOutp = Sheets(strFile)
        On Error GoTo 0
        If Not wsOutp Is Nothing Then
            wsOutp.Delete
        End If
        ' (Re)Create the worksheet, give it the file name
        Set wsOutp = ThisWorkbook.Sheets.Add(after:=wsLog)
        wsOutp.Name = strFile
        
        ' Now open the file, and copy contents
        OpenClosePDF colFiles(i), strPath
        CopyStep wsOutp
    Next i
    
    Application.DisplayAlerts = True

End Sub
Sub OpenClosePDF(ByVal sAdobeFile As String, ByVal sPath As String)

    Dim sAdobeApp As String
    Dim vStartAdobe As Variant
    
    sAdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 5.0\Reader\AcroRd32.exe"
    sAdobeApp = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe"
    vStartAdobe = Shell("" & sAdobeApp & " " & sPath & sAdobeFile & "", 1)
    Application.Wait (Now + TimeValue("0:00:01"))

End Sub


Private Sub CopyStep(wsOutp As Worksheet)

    ' select all & copy
    SendKeys "^a", True
    SendKeys "^c", True
     Application.Wait (Now + TimeValue("0:00:01"))
   ' Paste into the sheet from cell A1
    wsOutp.Paste Cells(1, 1)
   
    Application.Wait (Now + TimeValue("0:00:01"))
    AppActivate "Adobe Reader"
    ' close Reader
    SendKeys "%{F4}", True

End Sub

How to copy data from pdf to excel using VBA for multiple sheets?

harikris2013

Board Regular

MHamid

Active Member

Excel Facts

join

New Member

sijpie

Well-known Member

Similar threads

Forum statistics

Share this page

How to copy data from pdf to excel using VBA for multiple sheets?

harikris2013

Board Regular

MHamid

Active Member

Excel Facts

join

New Member

sijpie

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock