Stamp PDFs using Adobe Acrobat

stampPDFs.vba

Sub stampPDFs()
    On Error Resume Next
    
    Dim App As CAcroApp
    Dim PDDoc As CAcroPDDoc
    Dim fso As Scripting.FileSystemObject
    Dim jso As Object
    Dim i As Long
    Dim FileName As String
    Dim field As Object
    Dim rect(3) As Integer
    Dim objFolder As Scripting.Folder
    Dim objFile As Scripting.File
    Const inch = 72

    Set App = CreateObject("AcroExch.App")
    Set PDDoc = CreateObject("AcroExch.PDDoc")
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set objFldr = fso.GetFolder("Y:\steven\Receipts")
    For Each objFolder In objFldr.SubFolders
        
        For Each objFile In objFolder.Files
        
            If PDDoc.Open(objFile.Path) Then
                Debug.Print objFile.Path
                Set jso = PDDoc.GetJSObject
                Set pgsize = PDDoc.AcquirePage(0).GetSize()
                
                rect(0) = 0.25 * inch ' x lower left
                rect(1) = 0.25 * inch  ' y lower left
                rect(2) = pgsize.x - (0.25 * inch)  ' x upper right
                rect(3) = 0.5 * inch   ' y upper right
                
                ' add a form field
                Set field = jso.addField("myFormField", "text", 0, rect)
                
                field.Value = objFile.Name
                field.textFont = "ArialNarrow"
                field.textColor = Array("RGB", 255, 0, 0)
                field.fillColor = Array("RGB", 255, 255, 255)
                jso.flattenPages
                
                i = PDDoc.Save(PDSaveFull, objFile.Path)
            End If
            
            PDDoc.Close
            
        Next objFile
    Next objFolder
End Sub

Hi Steven,

Thank you very much for this VBA. Unfortunately i hadn't success running this VBA. Is it possible to ask have a Zoom meeting with me to create the VBA with dynamic pdf stamps. This will assist me a lot

My email: [email protected]