About VBA using Acrobat Standard DC

Question

Using VBA from Access, the process of appending to PDF does not work
It worked on Windows 2012, but stopped working on Windows 11
No errors, but not appended.what is the cause?

1.OS and Acrobat
■OK
WindowsServer2012 standard 64bit
Acrobat standard XI 32bit?
Access2007 32bit

■NG
Windows11 64bit
Acrobat standard DC 32bit and 64bit
Office365 32bit 64bit and Access2007 32bit

2.VBA Reference settings

■OK
Visual Basic For Applicatons
Microsoft Access 12.0 Object Library
OLE Automation
Microsoft DAO 3.6 Object Library
Microsoft ActiveX Data Objects 2.1 Library
Microsoft Windows Common Controls 6.0
Adobe Acrobat 10.0 Type Library

■NG
Visual Basic For Applicatons
Microsoft Access 12.0 Object Library
OLE Automation
Microsoft DAO 3.6 Object Library
Microsoft ActiveX Data Objects 2.1 Library
Adobe Acrobat 10.0 Type Library
Microsoft Scripting Runing
Microsoft Windows Common Controls 6.0

達也312770832b0a · Answer

code is below.please

   Dim db                           As Database
    
    Dim rsIn                         As Recordset

    Dim strPath                      As String
    Dim strQry                       As String
    Dim strCopyFrom                  As String
    Dim strContents                  As String
    Dim intPage                      As Integer
    Dim intHeight                    As Integer
    Dim intCount                     As Integer
    Dim intMod                       As Integer
       
    Dim pdDoc                        As Acrobat.CAcroPDDoc
    Dim rc                           As Integer
    Dim jsObj                        As Object
    
    strCopyFrom = Me.txtDataPath02
    strPath = Mid(strCopyFrom, 1, Len(strCopyFrom) - 4) & strDateTime & ".pdf"
    FileCopy strCopyFrom, strPath
    
    Set pdDoc = CreateObject("AcroExch.PDDoc")
    If pdDoc Is Nothing Then
        MsgBox ("Failed to create Acrobat PDDoc object.")
        Exit Sub
    End If
    
    ' Open the source PDF document
    rc = pdDoc.Open(strPath)
    If rc <> -1 Then
        MsgBox ("Failed to open PDF document " & strPath)
        End
    End If
    Set jsObj = pdDoc.GetJSObject
    
    Set db = CurrentDb
    
    strQry = "SELECT * FROM TBL_DATA ORDER BY 連番"
    Set rsIn = db.OpenRecordset(strQry, dbOpenDynaset)
    
    intPage = 0
    intCount = 0
    
    Do Until rsIn.EOF
        strContents = rsIn![社内受注番号]
        intMod = intPage Mod 2
        Select Case intMod
            Case 0
                jsObj.addWatermarkFromText _
                      strContents, _
                      jsObj.App.Constants.Align.center, _
                      "OCRB", _
                      16, _
                      jsObj.Color.blue, _
                      intPage, _
                      intPage, _
                      True, _
                      True, _
                      True, _
                      jsObj.App.Constants.Align.center, _
                      jsObj.App.Constants.Align.center, _
                      270, _
                      130, _
                      False, _
                      1, _
                      False, _
                      0, _
                      1
                rsIn.MoveNext
                If Not rsIn.EOF Then
                    strContents = rsIn![社内受注番号]
                    jsObj.addWatermarkFromText _
                          strContents, _
                          jsObj.App.Constants.Align.center, _
                          "OCRB", _
                          10, _
                          jsObj.Color.blue, _
                          intPage, _
                          intPage, _
                          True, _
                          True, _
                          True, _
                          jsObj.App.Constants.Align.center, _
                          jsObj.App.Constants.Align.center, _
                          270, _
                          -90, _
                          False, _
                          1, _
                          False, _
                          0, _
                          1
                    rsIn.MoveNext
                    If Not rsIn.EOF Then
                        strContents = rsIn![社内受注番号]
                        jsObj.addWatermarkFromText _
                              strContents, _
                              jsObj.App.Constants.Align.center, _
                              "OCRB", _
                              16, _
                              jsObj.Color.blue, _
                              intPage, _
                              intPage, _
                              True, _
                              True, _
                              True, _
                              jsObj.App.Constants.Align.center, _
                              jsObj.App.Constants.Align.center, _
                              270, _
                              -260, _
                              False, _
                              1, _
                              False, _
                              0, _
                              1
                        rsIn.MoveNext
                    End If
                End If
            Case 1
                jsObj.addWatermarkFromText _
                      strContents, _
                      jsObj.App.Constants.Align.center, _
                      "OCRB", _
                      10, _
                      jsObj.Color.blue, _
                      intPage, _
                      intPage, _
                      True, _
                      True, _
                      True, _
                      jsObj.App.Constants.Align.center, _
                      jsObj.App.Constants.Align.center, _
                      270, _
                      110, _
                      False, _
                      1, _
                      False, _
                      0, _
                      1
                rsIn.MoveNext
                If Not rsIn.EOF Then
                    strContents = rsIn![社内受注番号]
                    jsObj.addWatermarkFromText _
                          strContents, _
                          jsObj.App.Constants.Align.center, _
                          "OCRB", _
                          16, _
                          jsObj.Color.blue, _
                          intPage, _
                          intPage, _
                          True, _
                          True, _
                          True, _
                          jsObj.App.Constants.Align.center, _
                          jsObj.App.Constants.Align.center, _
                          270, _
                          -60, _
                          False, _
                          1, _
                          False, _
                          0, _
                          1
                    rsIn.MoveNext
                    If Not rsIn.EOF Then
                        strContents = rsIn![社内受注番号]
                        jsObj.addWatermarkFromText _
                              strContents, _
                              jsObj.App.Constants.Align.center, _
                              "OCRB", _
                              10, _
                              jsObj.Color.blue, _
                              intPage, _
                              intPage, _
                              True, _
                              True, _
                              True, _
                              jsObj.App.Constants.Align.center, _
                              jsObj.App.Constants.Align.center, _
                              270, _
                              -280, _
                              False, _
                              1, _
                              False, _
                              0, _
                              1
                        rsIn.MoveNext
                    End If
                End If
        End Select
        
        intPage = intPage + 1
        
    Loop
    
    rsIn.Close
    
    db.Close
    
     ' save the PDF with watermarks to a new document.
     rc = pdDoc.Save(1, strPath)  ' full save
    
     ' close original PDF.
     pdDoc.Close
    
     Set pdDoc = Nothing
     Set jsObj = Nothing
    
     ' to clean up, get the Acrobat application,
     ' close Acrobat if there are no open documents.
     Dim gApp As Acrobat.CAcroApp
     Set gApp = CreateObject("AcroExch.App")
     If gApp.GetNumAVDocs = 0 Then
         gApp.CloseAllDocs
         gApp.Exit
     End If
      
End Sub

Sign up

To post, reply, or follow discussions, please sign in with your Adobe ID.

Sign in to Adobe Community

To post, reply, or follow discussions, please sign in with your Adobe ID.

Scanning file for viruses.

This file cannot be downloaded