Adding Dig Sig blocks to PDF

[Thompyt]

Hello all,


I have gleaned and tried to modify some VBA code to add 3 digital signature blocks to an exported pdf. It seems to be doing something, but I cannot get it to save the file. I understand the 3 sigs will be in 1 spot at the moment. That will be fixed once I have it at least adding the fields and saving the file. Where am I going wrong, and how many ways?

I called the below function as PreparePDF InputPDF where InputPDF = ""C:\TEMP" & "0009TAR(" & FNames & ")(" & TODA & ")(" & [FT] & ")" & Rev & "_" & TOD & ".pdf"

Public Function PreparePDF(InputPDF As String) As BooleanConst Y = 524   
Const X = 14
Const W = 106
Const H = 59
Dim strFName as String
    
    strFName = Left(InputPDF, Len(InputPDF) - 4) & "s.pdf"


Dim pdfPDDoc As Acrobat.AcroPDDoc
Dim OutputPdf As String: OutputPdf = strFNameSig
Dim sg_arr() As Variant: sg_arr = Array(X, Y + H, X + W, Y)
Dim sg_arr1() As Variant: sg_arr = Array(X, Y + H, X + W, Y)
Dim sg_arr2() As Variant: sg_arr = Array(X, Y + H, X + W, Y)
Dim oJS As Object, oPpklite As Object, SignField As Object, SignField1 As Object, SignField2 As Object
Dim HadError As Boolean: HadError = False

Set pdfPDDoc = New AcroPDDoc


    If pdfPDDoc.Open(InputPDF) Then
        Set oJS = pdfPDDoc.GetJSObject
        Set oPpklite = oJS.security.getHandler("Adobe.PPKLite")
            Set SignField = oJS.AddField("Sgn", "Signature", 0, sg_arr)
            Set SignField1 = oJS.AddField("Sgn2", "Signature2", 0, sg_arr1)
            Set SignField2 = oJS.AddField("Sgn3", "Signature3", 0, sg_arr2)
                pdfPDDoc.Save 1, OutputPdf
    End If
    
If Not oPpklite Is Nothing Then oPpklite.logout
Set oJS = Nothing
Set oPpklite = Nothing
Set pdfPDDoc = Nothing

End Function

[Thompyt]

I tried the following:

Sub Prepare_PDF()
    On Error GoTo Err_Handler
   
Dim pdfPDDoc As New AcroPDDoc, 
DIM oJS As Object, oFields As Object
Dim strFName As String, TODA As String, FNames As String, Rev As String, FT As String
 
    TODA = DLookup("[TODA]", "[QryTAR]")
    FNames = DLookup("[FNames]", "[QryTAR]", "[Select] = True")
    Rev = DLookup("[Type]", "[QryTAR]")
    FT = DLookup("[FTCode]", "[QryTAR]")
 
   
    strFName = "C:\TEMP\" & "0009TAR(" & FNames & ")(" & TODA & ")(" & [FT] & ")" & Rev & "_" & TOD & ".pdf"
   
    If pdfPDDoc.Open(strFName) Then                                                                                 ' Add a signature field to the PDF file
        Set oJS = pdfPDDoc.GetJSObject
        Set oFields = oJS.addField("SignatureField1", "signature", 0, Array(200, 620, 450, 670))

        strFName = Left(strFName, Len(strFName) - 4) & "s.pdf"                                                      ' Save the signed PDF file
        pdfPDDoc.Save 1, strFName
    End If
   
Exit_Proc:
    Exit Sub
 
Err_Handler:
    MsgBox "Error: " & Err.Number & " - " & Err.Description
    Resume Exit_Proc
End Sub

It opens the file and saves the file correctly with no observable errors, but there is no signature box on the PDF. The bold text is where I need some clarification on please.

[Thompyt]

I found the following works for me. For the most part anyways. When I select Save, I get a blank pdf form, I close that and save again, I then get the correct pdf form and have all 3 of the signature blocks where I need them.

I am having an issue with the correct way to save the updated form. Can someone advise on the blank form and the means to save?

Thanks!

Public Sub ExportRpt_Click()Dim App As Object, AVDoc As Object, AForm As Object
Dim TODA As String, FNames As String, Rev As String, FT As String, Path As String, js As String, js1 As String, js2 As String
    
On Error GoTo Err_Handler
    
    TODA = DLookup("[TODA]", "[QryTAR]")
    FNames = DLookup("[FNames]", "[QryTAR]")
    Rev = DLookup("[Type]", "[QryTAR]")
    FT = DLookup("[FTCode]", "[QryTAR]")


    Set App = CreateObject("Acroexch.app")
        App.Show 'Hide
    Set AVDoc = CreateObject("AcroExch.AVDoc")
    Set AForm = CreateObject("AFormAut.App")
    
    Path = "C:\TEMP\" & "0009TAR(" & FNames & ")(" & TODA & ")(" & [FT] & ")" & Rev & "_" & TOD & ".pdf"
    
    If Me.[WCostComp] = True Then
         DoCmd.OutputTo 3, "RptCostComp", acFormatPDF, "C:\TEMP\" & "CostComp(" & FNames & ")(" & TODA & ")(" & [FT] & ")" & Rev & "_" & TOD & ".pdf", , 0
    End If
    
    On Error Resume Next
    DoCmd.OutputTo 3, "RptTAR", acFormatPDF, "Path, , 0"
        
    If AVDoc.Open(Path, "") Then
        js = "f = this.addField(""SignatureField"", ""signature"", 0, [26,174,243,134]);" & "f.value = ""TPOC""; " & " f.flatten"
            AForm.Fields.ExecuteThisJavaScript js
        js1 = "f = this.addField(""SignatureField1"", ""signature"", 0, [267,174,483,134]);" & "f.value = ""PM""; " & "f.flatten"
            AForm.Fields.ExecuteThisJavaScript js1
        js2 = "f = this.addField(""SignatureField2"", ""signature"", 0, [534,174,750,134]);" & "f.value = ""COR""; " & "f.flatten"
            AForm.Fields.ExecuteThisJavaScript js2
    End If
        
    Path = Left(Path, Len(Path) - 4) & "s.pdf"
        AVDoc.Save 1, Path
        
'    Set App = Nothing
'    Set AVDoc = Nothing
'    Set AForm = Nothing
'    Path = ""
        
Exit_Proc:
    Exit Sub


Err_Handler:
    MsgBox "Error: " & Err.Number & " - " & Err.Description
    Resume Exit_Proc
End Sub

[Thompyt]

Completed to do what I need

Public Sub AddSigBoxes()Dim App As Object, AVdoc As Object, AForm As Object
Dim TODA As String, FNames As String, Rev As String, FT As String, Path As String, js As String, js1 As String, js2 As String


    On Error GoTo Err_Handler


    TODA = DLookup("[TODA]", "[QryTAR]")
    FNames = DLookup("[FNames]", "[QryTAR]")
    Rev = DLookup("[Type]", "[QryTAR]")
    FT = DLookup("[FTCode]", "[QryTAR]")


    Set App = CreateObject("Acroexch.app")
        App.Hide
    Set AVdoc = CreateObject("AcroExch.AVDoc")
    Set AForm = CreateObject("AFormAut.App")
       
    Path = "C:\TEMP\" & "0009TAR(" & FNames & ")(" & TODA & ")(" & [FT] & ")" & Rev & "_" & TOD & ".pdf"
    
    If AVdoc.Open(Path, "") Then
        js = "f = this.addField(""SignatureField"", ""signature"", 0, [26,174,243,134]);" & "f.value = ""TPOC""; " & " f.flatten"
            AForm.Fields.ExecuteThisJavaScript js
        js1 = "f = this.addField(""SignatureField1"", ""signature"", 0, [267,174,483,134]);" & "f.value = ""PM""; " & "f.flatten"
            AForm.Fields.ExecuteThisJavaScript js1
        js2 = "f = this.addField(""SignatureField2"", ""signature"", 0, [534,174,750,134]);" & "f.value = ""COR""; " & "f.flatten"
            AForm.Fields.ExecuteThisJavaScript js2
    
       Path = Left(Path, Len(Path) - 4) & "s.pdf"
         
    Set AForm = AVdoc.GetPDDoc
        AForm.Save PDSaveFull, Path
            AVdoc.Close False
    End If


    App.Exit


    Set App = Nothing
    Set AVdoc = Nothing
    Set AForm = Nothing
    Path = ""
        
Exit_Proc:
    Exit Sub


Err_Handler:
    MsgBox "Error: " & Err.Number & " - " & Err.Description
    Resume Exit_Proc


End Sub