Friday, June 26, 2020

Automated multiple PDF files batch data entry using VBA and Acrobat Library

Option Explicit
Public Const pdf_form_file  As String = "C:\Users\allso\Desktop\New Customer Registration Form.pdf"
Sub readpdfformfield()
Sheets("PDF_Form_Fields").Select
Cells.Clear
Dim eapp As Acrobat.AcroApp
Dim av_doc As Acrobat.AcroAVDoc
Dim pdf_form As AFORMAUTLib.AFormApp
Dim pdf_form_flds As AFORMAUTLib.Fields
Dim pdf_form_fld As AFORMAUTLib.Field
Dim rng, firstcell As Range
Dim rownum, colnum As Integer
rownum = 1: colnum = 1
Set eapp = CreateObject("AcroExch.App")
Set av_doc = CreateObject("AcroExch.AVDoc")
If av_doc.Open(pdf_form_file, "") = True Then
av_doc.BringToFront
eapp.Hide
Set pdf_form = CreateObject("AFORMAUT.App")
Set pdf_form_flds = pdf_form.Fields

For Each pdf_form_fld In pdf_form_flds

With pdf_form_fld
'Debug.Print .Name & "|" & .Type & "|" & .Value
Cells(rownum, colnum) = .Name & "|" & .Type & "|" & .Value
Cells(rownum, colnum).Select
Set rng = Cells(rownum, colnum)
'MsgBox (rng.Address)
 'rng.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", TrailingMinusNumbers:=True
Set firstcell = Cells(rownum, rng.Column)
'MsgBox (firstcell.Address)
rng.TextToColumns Destination:=firstcell, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", TrailingMinusNumbers:=True

rownum = rownum + 1

End With
Next pdf_form_fld

av_doc.Close False

End If

eapp.Exit

Set av_doc = Nothing
Set eapp = Nothing

End Sub


Sub write_to_pdf_form()
Dim filenamepart As Integer
filenamepart = 1
Sheets("DataForPDF").Select
Range("A1").Select
Dim startrange As Range
Set startrange = Selection
While ActiveCell.Value <> ""

Dim pdfapp As Acrobat.AcroApp
Dim pdfdoc As Acrobat.AcroAVDoc
Dim support_doc As Acrobat.AcroPDDoc

Dim pdf_form As AFORMAUTLib.AFormApp
Dim pdf_form_flds As AFORMAUTLib.Fields

Dim givenname As AFORMAUTLib.Field
Dim familyname As AFORMAUTLib.Field
Dim address1 As AFORMAUTLib.Field
Dim phonenumber As AFORMAUTLib.Field
Dim findsource As AFORMAUTLib.Field
Dim email As AFORMAUTLib.Field
Dim willingtorecommend As AFORMAUTLib.Field
Set pdfapp = CreateObject("AcroExch.App")
Set pdfdoc = CreateObject("AcroExch.AVDoc")


If pdfdoc.Open(pdf_form_file, "") = True Then
pdfdoc.BringToFront
pdfapp.Hide
Set pdf_form = CreateObject("AFORMAUT.App")
Set pdf_form_flds = pdf_form.Fields

Set givenname = pdf_form.Fields("fullName3[first]")
Set familyname = pdf_form.Fields("fullName3[last]")
Set address1 = pdf_form.Fields("address4[addr_line1]")
Set phonenumber = pdf_form.Fields("phoneNumber5[full]")
Set email = pdf_form.Fields("email6")
Set findsource = pdf_form.Fields("howDid8")
Set willingtorecommend = pdf_form.Fields("willYou[0]")

Sheets("DataForPDF").Select
Cells(filenamepart, 1).Select


givenname.Value = ActiveCell.Value

familyname.Value = ActiveCell.Offset(0, 1).Value
address1.Value = ActiveCell.Offset(0, 2).Value
phonenumber.Value = ActiveCell.Offset(0, 3).Value
email.Value = ActiveCell.Offset(0, 4).Value
findsource.Value = ActiveCell.Offset(0, 5).Value
willingtorecommend.Value = ActiveCell.Offset(0, 6).Value

Set support_doc = pdfdoc.GetPDDoc

Dim path As String
path = "C:\Users\allso\Desktop\excel_to_pdf\output_" & filenamepart & ".pdf"
filenamepart = filenamepart + 1
'MsgBox (path)
If support_doc.Save(PDSaveFull, path) Then
Debug.Print "Saved"
Else
Debug.Print "Failed to save"


End If

pdfdoc.Close True
support_doc.Close
pdfapp.Exit

Set givenname = Nothing
Set familyname = Nothing
Set address1 = Nothing
Set phonenumber = Nothing
Set email = Nothing
Set findsource = Nothing
Set willingtorecommend = Nothing
Set pdfdoc = Nothing
Set support_doc = Nothing
End If

Wend

End Sub



No comments:

Post a Comment