Hi,
You need to extract the data to a excel workbook. You can then be able to extract the data you require for it to the actual workbook.
The following is a code that I used when I had a Trial copy of Adobe.
Code:
Option Base 1
Sub CQCard_Process()
Application.ScreenUpdating = False
Dim myArray As Variant
Dim Mycount As Long
Dim CurFile As String
Dim Destwb As Workbook
Dim rng As Range
Dim mydt As String
Dim lrow As Long
Dim Onr As String
Dim sFileName As String
myArray = Array("OrderNr.", "FileNr", "Indent", "Date Of Order")
lrow = Range("A" & Rows.Count).End(xlUp).Row
Const DirLoc As String = "C:\QCCard\"
CurFile = Dir(DirLoc & "*.XLSX")
''' CHeck to see if you have QCCards to process.'''
If CurFile = "" Then
MsgBox "You do not have QC Cards to process!"
Exit Sub
End If
Do While CurFile <> vbNullString ''' we open new workbook tehn populate it with the data
CurFile = Dir(DirLoc & "*.XLSX")
If CurFile = "" Then Exit Sub
Dim Origwb As Workbook
Set Destwb = Workbooks.Add
Set Origwb = Workbooks.Open(Filename:=DirLoc & CurFile) ''Here we open each workbook in the file
''' Populate the data to new workbook '''
With Origwb
.Sheets("Table 1").Range("AC8").WrapText = False
.Sheets("Table 1").Range("AC3").WrapText = False
.Sheets("Table 1").Range("v2").WrapText = False
.Sheets("Table 1").Range("c1").WrapText = False
.Sheets("Table 1").Range("AC8").MergeCells = False
.Sheets("Table 1").Range("AC3").MergeCells = False
.Sheets("Table 1").Range("v2").MergeCells = False
.Sheets("Table 1").Range("c1").MergeCells = False
End With
Destwb.Activate
Set rng = ActiveSheet.Range("A1:D1")
With Destwb
With Worksheets("Sheet1")
For Mycount = 1 To UBound(myArray)
.Cells(1, Mycount).Value = myArray(Mycount)
Next Mycount
End With
Origwb.Sheets("Table 1").Range("AC8").Value = Replace(Right(Origwb.Sheets("Table 1").Range("AC8").Value, _
Len(Origwb.Sheets("Table 1").Range("AC8").Value) - InStr(Origwb.Sheets("Table 1").Range("AC8").Value, Chr(10))), " ", "")
Origwb.Sheets("Table 1").Range("AC3").Value = Replace(Right(Origwb.Sheets("Table 1").Range("AC3").Value, _
Len(Origwb.Sheets("Table 1").Range("AC3").Value) - InStr(Origwb.Sheets("Table 1").Range("AC3").Value, Chr(10))), " ", "")
Origwb.Sheets("Table 1").Range("c1").Value = Replace(Right(Origwb.Sheets("Table 1").Range("c1").Value, _
Len(Origwb.Sheets("Table 1").Range("c1").Value) - InStr(Origwb.Sheets("Table 1").Range("c1").Value, Chr(10))), " ", "")
Origwb.Sheets("Table 1").Range("v2").Value = Replace(Right(Origwb.Sheets("Table 1").Range("v2").Value, _
Len(Origwb.Sheets("Table 1").Range("v2").Value) - InStr(Origwb.Sheets("Table 1").Range("v2").Value, Chr(10))), " ", "")
mydt = Format(Origwb.Sheets("Table 1").Range("AC8").Value, "mm-dd-yy")
.Sheets("Sheet1").Range("A2").Value = Trim(Mid(Origwb.Sheets("Table 1") _
.Range("AC3").Value, InStr(1, Origwb.Sheets("Table 1").Range("Ac3").Text, " #") + 1)) '''order
.Sheets("Sheet1").Range("B2").Value = Trim(Mid(Origwb.Sheets("Table 1") _
.Range("V2").Value, InStr(1, Origwb.Sheets("Table 1").Range("V2").Text, " #") + 1))
.Sheets("Sheet1").Range("C2").Value = Trim(Mid(Origwb.Sheets("Table 1") _
.Range("C1").Value, InStr(1, Origwb.Sheets("Table 1").Range("C1").Text, ".") + 1)) '' Indent
.Sheets("sheet1").Range("D2").Value = mydt ''' Date
Title = Destwb.Sheets("Sheet1").Range("A2") & "_" & Destwb.Sheets("Sheet1") _
.Range("B2") & "_" & mydt
sFileName = "C:\QCCard\QCCompleted\" & Title
ActiveWorkbook.SaveAs Filename:=sFileName ', FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True
Application.EnableEvents = False
'''''''' Move file to QCProcessed we will kill the original
ActiveWorkbook.SaveAs "C:\QCCard\QCProcessed\" & Origwb.Name
ActiveWorkbook.Close
Kill "C:\QCCard\" & CurFile
Application.EnableEvents = True
End With
' Next i
Loop
Application.ScreenUpdating = True
MsgBox "QCCard Run Complete"
End Sub
When you extract the PDF to excel you can post it here and I or someone my be able to help.