A problem with .GETJSObject in VBA?

New Here ,
Mar 29, 2019

Copy link to clipboard

Copied

I built VBA code to run through a query list of PDF files, open the first file, add some watermark text, save it to a specific path and filename, THEN open each subsequent PDF from the query list sequentially and add watermark text, then insert the watermarked PDF copy into the first saved file. Everything works great when there are only 2-6 pages. I have query lists in the 300+ files (for 400+ pages). The code below fails with Run Time Error 91 at the GETJSObject line. The real head scratcher for me is that this error SEEMS to be speed/processor dependent in that it happens at different times on the same list. Sometimes failing at page 10, sometimes at page 284. Always at the GETJSOBject line (at least that's where the Access VBA shows it failing).

Any suggestions??

Code:

Public Sub PDF_PRINT_HIDDEN(path, parent, TSO, setqty, itemno)

    Dim PDFApp As AcroApp

    Dim PDFDoc As AcroAVDoc

    Dim newPDFDoc As AcroAVDoc

    Dim PDDoc As AcroPDDoc

    Dim newPDDoc As AcroPDDoc

    Dim jso As Object

    Dim PDFPath As String

    Dim UserID As String

    Dim watertxt As String

    Dim DisplayPage As Integer

    Dim strFirstMatch As String

    Dim position As Integer

    Dim p1 As String

    Dim WasSaved As Variant

   

    UserID = Environ("USERNAME")

    PDFPath = "X:\Drawings\"

    PDFPath = PDFPath & parent

    DisplayPage = 1

       

    Set PDFApp = CreateObject("AcroExch.App")

    Set PDFDoc = CreateObject("AcroExch.AVDoc")

    Set newPDFDoc = CreateObject("AcroExch.AVDoc")

    Set newPDDoc = CreateObject("AcroExch.PDDoc")

    If PDFDoc.Open(PDFPath, "") Then

        Set PDDoc = PDFDoc.GetPDDoc

        'MsgBox parent

        'If PDDoc Is Nothing Then

        '    MsgBox "No PDF Doc to use?"

        '    MsgBox parent

        'End If

       

        'Get JSO object

        Set jso = PDDoc.GetJSObject

               

        'Set WaterMark color

        Dim color(3) As Variant

        color(0) = "RGB"

        color(1) = 1

        color(2) = 0

        color(3) = 0

       

        'Get page size for stamp placement

        Dim pdf_Page As Acrobat.AcroPDPage

        Dim pg_Size As Object

        Dim pg_Rotation As Object

        Set pdf_Page = PDDoc.AcquirePage(0)

        Set pg_Size = pdf_Page.GetSize

        p1 = pg_Size.x / 72

        p2 = pg_Size.y / 72

        'MsgBox p1

       

        'You have to play with these numbers to get the watermark exactly where you want it

        Dim s_X As Double

        Dim s_Y As Double

        Dim s_Y1 As Double

        Dim s_Y2 As Double

        Dim s_Angle As Double

        Dim num As Integer

       

        If p1 = "8" Then

            s_X = 560

            s_Y = -325

            s_Y1 = -200

            s_Y2 = -100

        End If

        If p1 = "8.5" Then

            s_X = 580

            s_Y = -325

            s_Y1 = -200

            s_Y2 = -100

        End If

        If p1 = "11" Then

            s_X = 770

            If p2 = "17" Then

                s_Y = -525

                s_Y1 = -400

                s_Y2 = -300

                Else

                s_Y = -225

                s_Y1 = -100

                s_Y2 = 0

            End If

        End If

        If p1 = "17" Then

            s_X = 1205

            If p2 = "22" Then

                s_Y = -525

                s_Y1 = -400

                s_Y2 = -300

                Else

                s_Y = -325

                s_Y1 = -200

                s_Y2 = -100

            End If

        End If

        If p1 = "22" Then

            s_X = 1560

            If p2 = "34" Then

                s_Y = -1025

                s_Y1 = -900

                s_Y2 = -800

                Else

                s_Y = -525

                s_Y1 = -400

                s_Y2 = -300

            End If

        End If

        If p1 = "34" Then

            s_X = 2410

            s_Y = -525

            s_Y1 = -400

            s_Y2 = -300

        End If

       

        s_Angle = 90

        'AddWatermarkFromText(cText, nTextAlign, cFont, nFontSize, oColor, nStart, nEnd, bOnTop, bOnScreen, bOnPrint, nHorizAlign, nVertAlign, nHorizValue, nVertValue, bPercentage, nScale, bFixedPrint, nRotation, nOpacity)

        Call jso.addWatermarkFromText(TSO, 0, "Helvetica", 16, color, 0, 0, True, True, True, 0, 0, s_X, s_Y, False, 1, False, s_Angle, 0.5)

       

        s_Y = s_Y1

        Call jso.addWatermarkFromText(itemno, 0, "Helvetica", 16, color, 0, 0, True, True, True, 0, 0, s_X, s_Y, False, 1, False, s_Angle, 0.5)

       

        s_Y = s_Y2

        Call jso.addWatermarkFromText(setqty, 0, "Helvetica", 16, color, 0, 0, True, True, True, 0, 0, s_X, s_Y, False, 1, False, s_Angle, 0.5)

       

        If itemno = "Item #0" Then

            WasSaved = PDDoc.Save(PDSaveFull, path)

            Call PDFDoc.Close(nosave)

        End If

        If itemno <> "Item #0" Then

            If newPDFDoc.Open(path, "") Then

                Set newPDDoc = newPDFDoc.GetPDDoc

                num = newPDDoc.GetNumPages - 1

                If newPDDoc.InsertPages(num, PDDoc, 0, PDDoc.GetNumPages(), True) = False Then

                    MsgBox "Cannot insert pages"

                End If

                If newPDDoc.Save(PDSaveFull, path) = False Then

                    MsgBox "Cannot save the updated PDF file"

                End If

                Call PDFDoc.Close(True)

                Call newPDFDoc.Close(True)

            End If

        End If

    End If

    PDFApp.Exit

   

    Set PDFApp = Nothing

    Set PDFDoc = Nothing

    Set newPDFDoc = Nothing

    Set PDDoc = Nothing

    Set newPDDoc = Nothing

    Set jso = Nothing

    Set pdf_Page = Nothing

    Set pg_Size = Nothing

   

    On Error Resume Next

   

End Sub

TOPICS
Acrobat SDK and JavaScript

Views

1.4K

Likes

Translate

Translate

Report

Report
Community Guidelines
Be kind and respectful, give credit to the original source of content, and search for duplicates before posting. Learn more

A problem with .GETJSObject in VBA?

New Here ,
Mar 29, 2019

Copy link to clipboard

Copied

I built VBA code to run through a query list of PDF files, open the first file, add some watermark text, save it to a specific path and filename, THEN open each subsequent PDF from the query list sequentially and add watermark text, then insert the watermarked PDF copy into the first saved file. Everything works great when there are only 2-6 pages. I have query lists in the 300+ files (for 400+ pages). The code below fails with Run Time Error 91 at the GETJSObject line. The real head scratcher for me is that this error SEEMS to be speed/processor dependent in that it happens at different times on the same list. Sometimes failing at page 10, sometimes at page 284. Always at the GETJSOBject line (at least that's where the Access VBA shows it failing).

Any suggestions??

Code:

Public Sub PDF_PRINT_HIDDEN(path, parent, TSO, setqty, itemno)

    Dim PDFApp As AcroApp

    Dim PDFDoc As AcroAVDoc

    Dim newPDFDoc As AcroAVDoc

    Dim PDDoc As AcroPDDoc

    Dim newPDDoc As AcroPDDoc

    Dim jso As Object

    Dim PDFPath As String

    Dim UserID As String

    Dim watertxt As String

    Dim DisplayPage As Integer

    Dim strFirstMatch As String

    Dim position As Integer

    Dim p1 As String

    Dim WasSaved As Variant

   

    UserID = Environ("USERNAME")

    PDFPath = "X:\Drawings\"

    PDFPath = PDFPath & parent

    DisplayPage = 1

       

    Set PDFApp = CreateObject("AcroExch.App")

    Set PDFDoc = CreateObject("AcroExch.AVDoc")

    Set newPDFDoc = CreateObject("AcroExch.AVDoc")

    Set newPDDoc = CreateObject("AcroExch.PDDoc")

    If PDFDoc.Open(PDFPath, "") Then

        Set PDDoc = PDFDoc.GetPDDoc

        'MsgBox parent

        'If PDDoc Is Nothing Then

        '    MsgBox "No PDF Doc to use?"

        '    MsgBox parent

        'End If

       

        'Get JSO object

        Set jso = PDDoc.GetJSObject

               

        'Set WaterMark color

        Dim color(3) As Variant

        color(0) = "RGB"

        color(1) = 1

        color(2) = 0

        color(3) = 0

       

        'Get page size for stamp placement

        Dim pdf_Page As Acrobat.AcroPDPage

        Dim pg_Size As Object

        Dim pg_Rotation As Object

        Set pdf_Page = PDDoc.AcquirePage(0)

        Set pg_Size = pdf_Page.GetSize

        p1 = pg_Size.x / 72

        p2 = pg_Size.y / 72

        'MsgBox p1

       

        'You have to play with these numbers to get the watermark exactly where you want it

        Dim s_X As Double

        Dim s_Y As Double

        Dim s_Y1 As Double

        Dim s_Y2 As Double

        Dim s_Angle As Double

        Dim num As Integer

       

        If p1 = "8" Then

            s_X = 560

            s_Y = -325

            s_Y1 = -200

            s_Y2 = -100

        End If

        If p1 = "8.5" Then

            s_X = 580

            s_Y = -325

            s_Y1 = -200

            s_Y2 = -100

        End If

        If p1 = "11" Then

            s_X = 770

            If p2 = "17" Then

                s_Y = -525

                s_Y1 = -400

                s_Y2 = -300

                Else

                s_Y = -225

                s_Y1 = -100

                s_Y2 = 0

            End If

        End If

        If p1 = "17" Then

            s_X = 1205

            If p2 = "22" Then

                s_Y = -525

                s_Y1 = -400

                s_Y2 = -300

                Else

                s_Y = -325

                s_Y1 = -200

                s_Y2 = -100

            End If

        End If

        If p1 = "22" Then

            s_X = 1560

            If p2 = "34" Then

                s_Y = -1025

                s_Y1 = -900

                s_Y2 = -800

                Else

                s_Y = -525

                s_Y1 = -400

                s_Y2 = -300

            End If

        End If

        If p1 = "34" Then

            s_X = 2410

            s_Y = -525

            s_Y1 = -400

            s_Y2 = -300

        End If

       

        s_Angle = 90

        'AddWatermarkFromText(cText, nTextAlign, cFont, nFontSize, oColor, nStart, nEnd, bOnTop, bOnScreen, bOnPrint, nHorizAlign, nVertAlign, nHorizValue, nVertValue, bPercentage, nScale, bFixedPrint, nRotation, nOpacity)

        Call jso.addWatermarkFromText(TSO, 0, "Helvetica", 16, color, 0, 0, True, True, True, 0, 0, s_X, s_Y, False, 1, False, s_Angle, 0.5)

       

        s_Y = s_Y1

        Call jso.addWatermarkFromText(itemno, 0, "Helvetica", 16, color, 0, 0, True, True, True, 0, 0, s_X, s_Y, False, 1, False, s_Angle, 0.5)

       

        s_Y = s_Y2

        Call jso.addWatermarkFromText(setqty, 0, "Helvetica", 16, color, 0, 0, True, True, True, 0, 0, s_X, s_Y, False, 1, False, s_Angle, 0.5)

       

        If itemno = "Item #0" Then

            WasSaved = PDDoc.Save(PDSaveFull, path)

            Call PDFDoc.Close(nosave)

        End If

        If itemno <> "Item #0" Then

            If newPDFDoc.Open(path, "") Then

                Set newPDDoc = newPDFDoc.GetPDDoc

                num = newPDDoc.GetNumPages - 1

                If newPDDoc.InsertPages(num, PDDoc, 0, PDDoc.GetNumPages(), True) = False Then

                    MsgBox "Cannot insert pages"

                End If

                If newPDDoc.Save(PDSaveFull, path) = False Then

                    MsgBox "Cannot save the updated PDF file"

                End If

                Call PDFDoc.Close(True)

                Call newPDFDoc.Close(True)

            End If

        End If

    End If

    PDFApp.Exit

   

    Set PDFApp = Nothing

    Set PDFDoc = Nothing

    Set newPDFDoc = Nothing

    Set PDDoc = Nothing

    Set newPDDoc = Nothing

    Set jso = Nothing

    Set pdf_Page = Nothing

    Set pg_Size = Nothing

   

    On Error Resume Next

   

End Sub

TOPICS
Acrobat SDK and JavaScript

Views

1.4K

Likes

Translate

Translate

Report

Report
Community Guidelines
Be kind and respectful, give credit to the original source of content, and search for duplicates before posting. Learn more
Mar 29, 2019 0
Most Valuable Participant ,
Mar 29, 2019

Copy link to clipboard

Copied

Acrobat is an end user tool with some VERY light duty automation. You are pushing it way too hard. Make sure you quit Acrobat at least every 50 files, perhaps more often. Of if you're bold, trap the failure and restart it then.

Likes

Translate

Translate

Report

Report
Community Guidelines
Be kind and respectful, give credit to the original source of content, and search for duplicates before posting. Learn more
Reply
Loading...
Mar 29, 2019 1
New Here ,
Apr 01, 2019

Copy link to clipboard

Copied

Test Screen Name: I don't understand your comment. The line PDFApp.Exit (11th from the bottom) quits Acrobat after each file. I figured this would be slower but more reliable.

I am not certain what you mean by "trap the failure and restart it then". Would you explain?

UPDATE: If I put a "msgbox parent" directly above the "Set PDDoc = PDFDoc.GetPDDoc" line, the code works for all 274 pages of my compiled PDFs but I have to click through each one. I've started playing with pause functions but even a 5 second pause isn't working...

Likes

Translate

Translate

Report

Report
Community Guidelines
Be kind and respectful, give credit to the original source of content, and search for duplicates before posting. Learn more
Reply
Loading...
Apr 01, 2019 0
New Here ,
Oct 03, 2019

Copy link to clipboard

Copied

If you use a debug.print instead of msgbox does it give you the same result?

Likes

Translate

Translate

Report

Report
Community Guidelines
Be kind and respectful, give credit to the original source of content, and search for duplicates before posting. Learn more
Reply
Loading...
Oct 03, 2019 0
Most Valuable Participant ,
Apr 01, 2019

Copy link to clipboard

Copied

Maybe the exit method isn’t working. I’ve seen reports of that. Suggest you test that by pausing and using task manager.

Likes

Translate

Translate

Report

Report
Community Guidelines
Be kind and respectful, give credit to the original source of content, and search for duplicates before posting. Learn more
Reply
Loading...
Apr 01, 2019 1