update pdf files with excel and adobe acrobat pro

[theprincipal78]

hi all

I am half way through with an excel project and I'm trying to bring it to an end.



here is the situation:
I have a folder with 20+ fillable pdf forms.


the precondition is:
1. Adobe Acrobat Pro is installed


for preparation:
1. I added a sheet called "WorkbookProperties" to the workbook. For storage of the folder path
1. I have hidden the sheet.


what I have accomplished so far:
with the below Function BrowseForFolderand the macros Select_A_Folder and Import_PDF_Files
I have managed to loop through the folder and add one sheet per pdf document to the workbook.
cell A2 contains the filename with hyperlink
cell C2 contains the file path
starting in cell A5 is the list of pdf field names


what is my goals:
1. write the pdf field values next to the pdf field names.
2. the pdf field values start in cell B5
3. most importently: upload the pdf field values and write them to the pdf in the folder

finally:
I even have a code that writes excel cell values to the pdf file. the problem is it is static and needs some amendment.
also find it further down. It's called Write_PDF_Forms


find the function and macros below.


Thanks. Appreciate your help.

'------------------------------------------------------------------------------------------------------------------------------------


Option Explicit


Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level


Dim ShellApp As Object


'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Select A Folder", 0, OpenAt)


'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0


'Destroy the Shell Application
Set ShellApp = Nothing


'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = ""
If Not Left(BrowseForFolder, 1) = "" Then GoTo Invalid
Case Else
GoTo Invalid
End Select


Exit Function


Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False


End Function


Sub Select_A_Folder()


On Error GoTo err_handle


Dim result As String
result = BrowseForFolder
Select Case result


Case Is = False
MsgBox "No folder selected.", vbInformation, "Information"


Case Else
Sheets("WorkbookProperties").Range("B2") = result
MsgBox "You selected" & vbNewLine & result, vbInformation, "Information"


End Select


Exit Sub
err_handle:
MsgBox "Cannot perform the task!", vbCritical, "Critical"
'MsgBox "No Table found", vbExclamation, "Not Found"


End Sub




Sub Import_PDF_Files()


On Error GoTo err_handle


Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim xlSheet As Worksheet


Application.ScreenUpdating = False


'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")


'Get the folder object
Set objFolder = objFSO.GetFolder(Sheets("WorkbookProperties").Range("B2"))


i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files


'-------------------------------------------------------------------------------------------


'add new sheet
Set xlSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)


'print file name
Cells(i + 1, 1) = objFile.Name


'print file path
Cells(i + 1, 3) = objFile.Path


'run macro
List_PDF_Fields


'sheet name
'ActiveSheet.Name = objFile.Name


'sheet name with prefix
ActiveSheet.Name = "PDF_" & objFile.Name


'-------------------------------------------------------------------------------------------


'insert labels
Range("A1").Value = "PDF File Name with Hyperlink"
Range("A1").Font.Bold = True


Range("A4").Value = "PDF Field Name"
Range("A4").Font.Bold = True


Range("B4").Value = "PDF Field Value"
Range("B4").Font.Bold = True


Range("C1").Value = "PDF File Path"
Range("C1").Font.Bold = True


'add hyperlink
ActiveSheet.Hyperlinks.Add Anchor:=Cells(2, 1), Address:=objFile.Path, TextToDisplay:=objFile.Name


'autofit
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select


'hide column
Columns("C:C").EntireColumn.Hidden = True


'views
'ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False


i = i
Next objFile


Exit Sub
err_handle:
MsgBox "Cannot perform the task!", vbCritical, "Critical"
'MsgBox "No Table found", vbExclamation, "Not Found"


End Sub

Option Explicit


Sub Write_PDF_Forms()

'--------------------------------------------------------------------------------------
'This macro uses the data in sheet Write in order to fill a sample PDF form named
'Test Form, which is located in the same folder with this workbook. The data from
'each row is used to create a new PDF file, which is saved in the Forms subfolder.

'The code uses late binding, so no reference to external library is required.
'However, the code works ONLY with Adobe Professional, so don't try to use it with
'Adobe Reader because you will get an "ActiveX component can't create object" error.

'Written by: Christos Samaras
'Date: 15/10/2013
'e-mail: xristos.samaras@gmail.com
'site: My Engineering World
'--------------------------------------------------------------------------------------


'Declaring the necessary variables.
Dim strPDFPath As String
Dim strFieldNames(1 To 11) As String
Dim i As Long
Dim j As Integer
Dim lastRow As Long
Dim objAcroApp As Object
Dim objAcroAVDoc As Object
Dim objAcroPDDoc As Object
Dim objJSO As Object
Dim strPDFOutPath As String

'Disable screen flickering.
Application.ScreenUpdating = False

'Specify the path of the sample PDF form.
'Full path example:
'strPDFPath = "C:\Users\Christos\Desktop\Test Form.pdf"
'Using workbook path:
strPDFPath = ThisWorkbook.Path & "" & "Test Form.pdf"

'Set the required field names in the PDF form.
strFieldNames(1) = "First Name"
strFieldNames(2) = "Last Name"
strFieldNames(3) = "Street Address"
strFieldNames(4) = "City"
strFieldNames(5) = "State"
strFieldNames(6) = "Zip Code"
strFieldNames(7) = "Country"
strFieldNames(8) = "E-mail"
strFieldNames(9) = "Phone Number"
strFieldNames(10) = "Type Of Registration"
strFieldNames(11) = "Previous Attendee"

'Find the last row of data in sheet Write.
With shWrite
.Activate
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

'Loop through all rows of sheet Write and use the data to fill the PDF form.
For i = 4 To lastRow

On Error Resume Next

'Initialize Acrobat by creating the App object.
Set objAcroApp = CreateObject("AcroExch.App")

'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Could not create the App object!", vbCritical, "Object error"
'Release the object and exit.
Set objAcroApp = Nothing
Exit Sub
End If

'Create the AVDoc object.
Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")

'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Could not create the AVDoc object!", vbCritical, "Object error"
'Release the objects and exit.
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Exit Sub
End If

On Error GoTo 0

'Open the PDF file.
If objAcroAVDoc.Open(strPDFPath, "") = True Then

'Set the PDDoc object.
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc

'Set the JS Object - Java Script Object.
Set objJSO = objAcroPDDoc.GetJSObject

On Error Resume Next

'Fill the form fields.
For j = 1 To 10

objJSO.GetField(strFieldNames(j)).Value = CStr(shWrite.Cells(i, j + 1).Value)

If Err.Number <> 0 Then

'Close the form without saving the changes.
objAcroAVDoc.Close True

'Close the Acrobat application.
objAcroApp.Exit

'Inform the user about the error.
MsgBox "The field """ & strFieldNames(j) & """ could not be found!", vbCritical, "Field error"

'Release the objects and exit.
Set objJSO = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Exit Sub

End If
Next j

'Fill the checkbox field.
If shWrite.Cells(i, j + 1).Value = "True" Then
objJSO.GetField(strFieldNames(11)).Value = "Yes"
End If

On Error GoTo 0

'Create the output path, which will be like C:\Users\Christos\Desktop\Forms\01) First Name Last Name.pdf.
With shWrite
If i - 3 < 10 Then
strPDFOutPath = ThisWorkbook.Path & "\Forms\0" & i - 3 & " " & .Cells(i, 2).Value & " " & .Cells(i, 3).Value & ".pdf"
Else
strPDFOutPath = ThisWorkbook.Path & "\Forms" & i - 3 & " " & .Cells(i, 2).Value & " " & .Cells(i, 3).Value & ".pdf"
End If
End With

'Save the form as new PDF file.
objAcroPDDoc.Save 1, strPDFOutPath

'Close the form without saving the changes.
objAcroAVDoc.Close True

'Close the Acrobat application.
objAcroApp.Exit

'Release the objects.
Set objJSO = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing

Else

MsgBox "Could not open the file!", vbCritical, "File error"

'Close the Acrobat application.
objAcroApp.Exit

'Release the objects and exit.
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Exit Sub

End If

Next i

'Enable the screen.
Application.ScreenUpdating = True

'Inform the user that forms were filled.
MsgBox "All forms were created successfully!", vbInformation, "Finished"

End Sub