Automate adding text box to PDFs: strange issue

New Here ,
Jan 08, 2020

Copy link to clipboard

Copied

Hello everyone,

 

I have an Access database with some VBA code in it that currently only works on a Windows 7 virtual machine with 32bit Office 2010 and Acrobat 8. I’m trying to get it to work on a Windows 10 machine with 64bit Office 365 and Acrobat DC. It uses cells in an Excel file to look for PDFs in a source folder, copies them to a destination folder, renames them 1.pdf, 2.pdf etcetera, and adds a text box with the correct number to the first page of the PDF.

When I press the button to do this, I get the following error:

Error number -2147221164

Description: Class not registered

which points to the following code:

image.png

 

 

 

 

When I ignore this error, the program starts copying and renaming PDFs, but does not add the text box to them. Each PDF results in the following error:

Error number 91:

Description: Object variable or With block variable not set

which points to this code:

image.png

 

Curiously, the whole process works when:

  • At least one of the destination PDFs has been created and is opened in Acrobat DC when I press the button (this will create all destination files and add text boxes to all but the opened file); or
  • The first source PDF file to be used is opened in Acrobat DC when I press the button (this creates all destination files with text boxes)

Can anyone explain this behavior? Full code below. The button executes BuildQueu (blnSim = false). The snippet that should add text boxes starts from the second image.

 

Full code (edit: some unnecessary code removed)

 

Private Sub BuildQueu(blnSim As Boolean)
Dim blnDoc As Boolean
Dim blnDocDone As Boolean
Dim blnDraw As Boolean
Dim blnDrawDone As Boolean
Dim blnExp As Boolean
Dim blnExpDone As Boolean
Dim blnMat As Boolean
Dim blnMatDone As Boolean
Dim blnPDF As Boolean

Dim intCol As Integer
Dim intGreenRow As Integer
Dim intRecordCount As Integer
Dim intRow As Integer
Dim intUnderScore As Integer

Dim strArt As String
Dim strArtExt As String
Dim strArtMem As String
Dim strCDPath As String
Dim strCR As String
Dim strDescr As String
Dim strDocFile As String
Dim strDocFileDescr As String
Dim strDocFileNoExt As String
Dim strDocIndex As String
Dim strExtraInfo As String
Dim strString As String
Dim strFileDest As String
Dim strFilePDF As String
Dim strFileSource As String
Dim strMachineNumber As String
Dim strOrgDrawing As String
Dim strDrawingPDF As String
Dim strProjectFile As String
Dim strProjectFileType As String
Dim strProjectPath As String
Dim strSimPath As String

Dim rst As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim rstIndex As DAO.Recordset
Dim docGreen As Word.Document

On Error GoTo ErrHandler
DoCmd.Hourglass True
Set dbs = CurrentDb

If StartWord Then
    cmdProjectClear_Click
    Me.Repaint
    
    If Not blnSim Then 'don't load Acrobat when just checking
        Set acrAVDoc = CreateObject("AcroExch.AVDoc")
        Set acrFormApp = CreateObject("AFormAut.App")
    End If
    
    strSimPath = MakePath(txtCPathDocument, txtCFolderPrintIndex)
    strProjectPath = MakePath(txtCPathProject, lstMachineType, lstProjectFolder)
    strDrawingPDF = MakePath(txtCPathDocument, txtCFolderDrawing)
    
    For intRow = 0 To lstProjectFile.ListCount - 1
        If lstProjectFile.Selected(intRow) Then
            strProjectFile = lstProjectFile.ItemData(intRow)
            strProjectFileType = Left(strProjectFile, 1)
            blnDoc = (strProjectFileType = "D") And chkDoc <> 0 And Not blnDocDone
            blnExp = (strProjectFileType = "D") And chkExp <> 0 And Not blnExpDone
            blnMat = (strProjectFileType = "M") And chkMat <> 0 And Not blnMatDone
            blnDraw = (strProjectFileType = "T") And chkDrawing <> 0 And Not blnDrawDone
            
            LinkAS400 MakePath(txtCPathProject, lstMachineType, lstProjectFolder, strProjectFile)
                    
            If Not blnDraw Then
                Set rst = dbs.OpenRecordset("SELECT TOP 1 * FROM tblAS400D") 'set path for CD-manual
                With rst
                    .MoveFirst
                    strMachineNumber = .Fields("SELPF") 'machine number in column A
                    .Close
                End With
            Else
                strMachineNumber = lstProjectFolder
                intUnderScore = InStr(1, strMachineNumber, "_")
                If intUnderScore Then strMachineNumber = Left(strMachineNumber, intUnderScore - 1)
            End If
            
            With appWord
                If blnDoc Then 'documentations-------------------------------------------------------------------
                    DoCmd.RunSQL "DELETE * FROM tblIndex"
                    DoCmd.OpenQuery "qryIndexDoc"
                    Set rst = dbs.OpenRecordset("qryIndexDocDescr") 'main documentation index per description
                    rst.MoveLast
                    intRecordCount = rst.RecordCount
                    
                    If intRecordCount > 0 Then
                        rst.MoveFirst
                        If blnSim Then
                            strCDPath = strSimPath
                        Else
                            strCDPath = MakePath(strProjectPath, "CD_" & strMachineNumber, txtCFolderCDDoc)
                        End If
                        strFile = "SP" & strMachineNumber & " per Description.doc"
                        strDocIndex = MakePath(strCDPath, strFile)
                        AddToProjectPrint strDocIndex
                        
                        With .Documents.Add(Template:=MakePath(txtCPathDocument, txtCFolderTemplate, "Index Documentations per Description.doc"))
                            With .Tables(1)
                                For intC = 2 To intRecordCount + 1
                                    Set docGreen = appWord.Documents.Add(Template:=MakePath(txtCPathDocument, txtCFolderTemplate, "Index Green.doc"))
                                    docGreen.Paragraphs(1).Range.InsertBefore rst.Fields("DDescription")
                                    
                                    If intC > 2 Then .Rows.Add
                                    .Cell(intC, 1).Range.InsertAfter Text:=rst.Fields("DDescription") 'description
                                    
                                    strDocFile = rst.Fields("DFileName")
                                    strDocFileNoExt = Left(strDocFile, Len(strDocFile) - 4) 'exclude extension
                                    
                                    'add article numbers to main and green documentation index
                                    intGreenRow = 2
                                    Set rst2 = dbs.OpenRecordset("SELECT DISTINCT ARTPF, ATag, AType FROM tblAS400D INNER JOIN qryArticlePlusDType ON tblAS400D.ARTPF=qryArticlePlusDType.ANumber WHERE qryArticlePlusDType.DType=1 AND DOCNR = '" & strDocFileNoExt & "' ORDER BY ARTPF")
                                    rst2.MoveFirst
                                    bln = False
                                    strArtExt = "" 'reset file name part containing art numbers
                                    strArtMem = ""
                                    Do While Not rst2.EOF
                                        strArt = rst2.Fields("ARTPF")
                                        If strArt <> strArtMem And Len(strArtExt) < 200 Then strArtExt = strArtExt & " " & strArt
                                        strArtMem = strArt
                                        If bln Then strCR = vbCr Else strCR = "" 'not first time
                                        .Cell(intC, 2).Range.InsertAfter Text:=strCR & rst2.Fields("AType")
                                        .Cell(intC, 3).Range.InsertAfter Text:=strCR & rst2.Fields("ARTPF")
                                        .Cell(intC, 4).Range.InsertAfter Text:=strCR & rst2.Fields("ATag")
                                        With docGreen.Tables(1)
                                            If bln Then .Rows.Add
                                            .Cell(intGreenRow, 1).Range.InsertAfter rst2.Fields("ARTPF") & ""
                                            .Cell(intGreenRow, 2).Range.InsertAfter rst2.Fields("ATag") & ""
                                            .Cell(intGreenRow, 3).Range.InsertAfter rst2.Fields("AType") & ""
                                        End With
                                        intGreenRow = intGreenRow + 1
                                        rst2.MoveNext
                                        bln = True
                                    Loop
                                    rst2.Close
                                                                                                
                                    .Cell(intC, 5).Range.InsertAfter Text:=intC - 1 'document number
                                    With docGreen
                                        .Bookmarks("bkmMachNumber").Range.InsertAfter strMachineNumber
                                        .Bookmarks("bkmDocNum").Range.Text = intC - 1
                                        strString = MakePath(strCDPath, "Green Index\Index " & intC - 1 & ".doc")
                                        strExtraInfo = "Error while saving " & strString
                                        .SaveAs FileName:=strString
                                        strExtraInfo = ""
                                        .Close
                                    End With
                                    With rst
                                        .Edit
                                        .Fields("INumber") = intC - 1
                                        .Update
                                        .MoveNext
                                    End With
                                Next
                                rst.Close
                            End With
                            .Bookmarks("bkmMachNumber").Range.InsertAfter strMachineNumber
                            strExtraInfo = "Error while saving " & strDocIndex
                            .SaveAs FileName:=strDocIndex
                            strExtraInfo = ""
                            .Close
                        End With
                    End If
                    
                    Set rst = dbs.OpenRecordset("qryIndexTag") 'main documentation index per tagnumber
                    rst.MoveLast 'populate recordset to establish recordcount
                    intRecordCount = rst.RecordCount
                    
                    If intRecordCount > 0 Then
                        rst.MoveFirst
                        strFile = "SP" & strMachineNumber & " per Tagnumber.doc"
                        With .Documents.Add(Template:=MakePath(txtCPathDocument, txtCFolderTemplate, "Index Documentations per Tagnumber.doc"))
                            With .Tables(1)
                                For intC = 2 To intRecordCount + 1
                                    If intC > 2 Then .Rows.Add 'index
                                    .Cell(intC, 1).Range.InsertAfter Text:=rst.Fields("ATag") & ""
                                    .Cell(intC, 2).Range.InsertAfter Text:=rst.Fields("ANumber") & ""
                                    .Cell(intC, 3).Range.InsertAfter Text:=rst.Fields("DDescription") & ""
                                    .Cell(intC, 4).Range.InsertAfter Text:=rst.Fields("AType") & ""
                                    .Cell(intC, 5).Range.InsertAfter Text:=rst.Fields("INumber") & ""
                                    rst.MoveNext
                                Next
                                rst.Close
                            End With
                            strDocIndex = MakePath(strCDPath, strFile)
                            AddToProjectPrint strDocIndex
                            .Bookmarks("bkmMachNumber").Range.InsertAfter strMachineNumber
                            strExtraInfo = "Error while saving " & strDocIndex
                            .SaveAs FileName:=strDocIndex
                            strExtraInfo = ""
                            .Close
                        End With
                                                       
                        'individual documentations
                        Set rst = dbs.OpenRecordset("SELECT IFileName, INumber, DDescription FROM tblIndex LEFT JOIN tblDocument ON tblIndex.IFileName = tblDocument.DFileName ORDER BY INumber")
                        With rst
                            .MoveFirst
                            Do While Not .EOF
                                strFile = Trim(.Fields("IFilename")) & ""
                                strDocFileNoExt = Left(strFile, Len(strFile) - 4) 'exclude extension
                                Set rst2 = dbs.OpenRecordset("SELECT DISTINCT ARTPF FROM tblAS400D WHERE DOCNR = '" & strDocFileNoExt & "' ORDER BY ARTPF")
                                With rst2
                                    If Not .EOF Then .MoveFirst
                                    strArtExt = ""
                                    Do While Not .EOF
                                        If Len(strArtExt) < 200 Then strArtExt = strArtExt & " " & Trim(.Fields("ARTPF"))
                                        .MoveNext
                                    Loop
                                End With
                                strDescr = .Fields("DDescription") & ""
                                strFileDest = MakePath(strCDPath, rst.Fields("INumber") & ".pdf")
                                
                                If strDescr = "" Then 'present in DOCNR, but missing from db
                                    AddToErrorList "Doc not registered in db", strFile

                                Else
                                    strFileSource = MakePath(txtCPathDocument, txtCFolderDoc, strFile) 'original source file
                                    If Not fso.FileExists(strFileSource) Then 'present in db, but actual file missing -> add to error list
                                        AddToErrorList "Doc file missing", strFileSource, strDescr
                                    
                                    Else 'file ok
                                        AddToProjectPrint MakePath(strCDPath, "Green Index\Index " & rst.Fields("INumber") & ".doc") 'add green index to queu
                                        AddToProjectPrint strFileDest 'add path for numbered documentation to queu
                                        If Not blnSim Then 'add to CD library
                                        
                                            acrAVDoc.Open strFileSource, strFile
                                            acrAVDoc.BringToFront
                                            Set acrForm = Nothing
                                            Set acrField = Nothing
                                            Set acrForm = acrFormApp.Fields
                                            On Error Resume Next
                                            'Set acrField = acrForm.Add("Num", "text", 0, 520, 20, 590, 70) 'JVB
                                            Set acrField = acrForm.Add("Num", "text", 0, 500, 20, 590, 90) 'JVB
                                            If Err Then
                                                Err.Clear
                                                AddToErrorList "Protected document", strFileSource, strDescr
                                            Else
                                                With acrField
                                                    .SetForegroundColor "RGB", 1, 1, 1, 0
                                                    .SetBackgroundColor "RGB", 0, 0, 0, 0
                                                    .Alignment = "center"
                                                    .TextSize = "48"
                                                    .TextFont = "Arial"
                                                    .Value = rst.Fields("INumber")
                                                    .IsReadOnly = True
                                                End With
                                            End If
                                            On Error GoTo ErrHandler
                                            
                                            Set acrPDDoc = acrAVDoc.GetPDDoc
                                            acrPDDoc.Save PDSaveFull, strFileDest
                                            acrAVDoc.Close True
                                        End If
                                    End If
                                End If
                                .MoveNext
                            Loop
                            .Close
                            strExtraInfo = ""
                        End With
                    End If
                   
                   'doc indicated by code 4,5,6,8
                    Set rst = dbs.OpenRecordset("SELECT ARTPF, CRTKD, DOCNR FROM tblAS400D WHERE (CRTKD='4' OR CRTKD='5' OR CRTKD='6' OR CRTKD='8') AND (DOCNR Is Null OR Trim([DOCNR])='')")
                    With rst
                        If Not .EOF Then
                            .MoveLast
                            intRecordCount = .RecordCount
                            If intRecordCount > 0 Then
                                .MoveFirst
                                Do While Not .EOF
                                    AddToErrorList "Documentation code missing in AS400 file for article number", .Fields("ARTPF")
                                    .MoveNext
                                Loop
                            End If
                        End If
                    End With
                        
                    blnDocDone = True
                End If
                
                If blnExp Then 'ex certificates------------------------------------------------------------------------
                    DoCmd.RunSQL "DELETE * FROM tblIndex" 'main ex certificates index per description
                    DoCmd.OpenQuery "qryIndexExp" 'fill tblIndex with ex file data
                    
                    Set rst = dbs.OpenRecordset("qryIndexExpDescr")
                    rst.MoveLast
                    intRecordCount = rst.RecordCount
                    
                    If intRecordCount > 0 Then
                        rst.MoveFirst
                        If blnSim Then
                            strCDPath = strSimPath
                        Else
                            strCDPath = MakePath(strProjectPath, "CD_" & strMachineNumber, txtCFolderCDManual, txtCFolderCDCert, txtCFolderCDExp)
                        End If
                        strFile = "EX" & strMachineNumber & ".doc"
                        strDocIndex = MakePath(strCDPath, strFile)
                        AddToProjectPrint strDocIndex
                        
                        With .Documents.Add(Template:=MakePath(txtCPathDocument, txtCFolderTemplate, "Index Ex-certificates per Description.doc"))
                            With .Tables(1)
                                For intC = 2 To intRecordCount + 1
                                    If intC > 2 Then .Rows.Add
                                    .Cell(intC, 1).Range.InsertAfter Text:=rst.Fields("DDescription") 'description
                                    
                                    strDocFile = rst.Fields("DFileName")
                                    strDocFileNoExt = Left(strDocFile, Len(strDocFile) - 4) 'exclude extension
                                    
                                    'add article, tag, type to main ex index
                                    Set rst2 = dbs.OpenRecordset("SELECT DISTINCT ARTPF FROM tblAS400D WHERE EXNR = '" & strDocFileNoExt & "' ORDER BY ARTPF")
                                    rst2.MoveFirst
                                    bln = False
                                    Do While Not rst2.EOF
                                        If bln Then strCR = vbCr Else strCR = "" 'not first time
                                        .Cell(intC, 2).Range.InsertAfter Text:=strCR & rst2.Fields("ARTPF")
                                        rst2.MoveNext
                                        bln = True
                                    Loop
                                    rst2.Close
                                    
                                    .Cell(intC, 3).Range.InsertAfter Text:=intC - 1 'document number
                                    With rst
                                        .Edit
                                        .Fields("INumber") = intC - 1
                                        .Update
                                        .MoveNext
                                    End With
                                Next
                                rst.Close
                            End With
                            .Bookmarks("bkmMachNumber").Range.InsertAfter strMachineNumber
                            strExtraInfo = "Error while saving " & strDocIndex
                            .SaveAs FileName:=strDocIndex
                            strExtraInfo = ""
                            .Close
                        End With
                                                              
                        'individual ex certificates
                        Set rst = dbs.OpenRecordset("SELECT IFileName, INumber, DDescription FROM tblIndex LEFT JOIN tblDocument ON tblIndex.IFileName = tblDocument.DFileName ORDER BY INumber")
                        With rst
                            .MoveFirst
                            Do While Not .EOF
                                strFile = Trim(.Fields("IFilename")) & ""
                                strDescr = .Fields("DDescription") & ""
                                strFileDest = MakePath(strCDPath, rst.Fields("INumber") & ".pdf")
            
                                If strDescr = "" Then 'present in EXNR, but missing from db -> add to error list
                                    AddToErrorList "Ex cert not registered in db", strFile
                                
                                Else
                                    strFileSource = MakePath(txtCPathDocument, txtCFolderExp, strFile) 'original source file
                                    If Not fso.FileExists(strFileSource) Then 'present in db, but actual file missing -> add to error list
                                        AddToErrorList "Ex cert file missing", strFileSource, strDescr
                                    
                                    Else
                                        AddToProjectPrint strFileDest 'add path for numbered ex cert queu
                                        If Not blnSim Then 'add to CD library
                                            acrAVDoc.Open strFileSource, strFile
                                            Set acrForm = acrFormApp.Fields
                                            'AcrobatField rst.Fields("INumber"), "Num", "text", "48", 520, 20, 590, 70 'JVB
                                            AcrobatField rst.Fields("INumber"), "Num", "text", "48", 500, 20, 590, 90 'JVB
                                            Set acrPDDoc = acrAVDoc.GetPDDoc
                                            acrPDDoc.Save PDSaveFull, strFileDest
                                            acrAVDoc.Close True
                                        End If
                                    End If
                                End If
                                .MoveNext
                            Loop
                            .Close
                        End With
                    End If
                    
                    'ex cert indicated by code 3,5,7,8 in CRTKD, but no EXNR found
                    Set rst = dbs.OpenRecordset("SELECT ARTPF, CRTKD, EXNR FROM tblAS400D WHERE (CRTKD='3' OR CRTKD='5' OR CRTKD>='7') AND (EXNR Is Null OR Trim([EXNR])='')")
                    With rst
                        If Not .EOF Then
                            .MoveLast
                            intRecordCount = .RecordCount
                            If intRecordCount > 0 Then
                                .MoveFirst
                                Do While Not .EOF
                                    AddToErrorList "Ex cert code missing in AS400 file for article number", .Fields("ARTPF")
                                    .MoveNext
                                Loop
                            End If
                        End If
                    End With
                    
                    blnExpDone = True
                End If
                
                If blnMat Then 'material certificates-----------------------------------------------------------------
                    Set rst = dbs.OpenRecordset("SELECT CRTNRExt, SEQN, DDescription FROM qryAS400Mat LEFT JOIN tblDocument ON qryAS400Mat.CRTNRExt = tblDocument.DFileName ORDER BY SEQN")
                    rst.MoveLast
                    intRecordCount = rst.RecordCount
                    
                    If intRecordCount > 0 Then
                        If blnSim Then
                            strCDPath = strSimPath
                        Else
                            strCDPath = MakePath(strProjectPath, "CD_" & strMachineNumber, txtCFolderCDDoc)
                            
                        End If
                        strFile = "Index Material Certificates.xls"
                        strDocIndex = MakePath(strCDPath, strFile)
                        AddToProjectPrint strDocIndex 'index is formatted excel file
                                                              
                        'individual mat certificates
                        With rst
                            .MoveFirst
                            Do While Not .EOF
                                strFile = Trim(.Fields("CRTNRExt")) & ""
                                strDescr = .Fields("DDescription") & ""
                                strFileDest = MakePath(strCDPath, rst.Fields("SEQN") & ".pdf")
            
                                If strDescr = "" Then 'present in CRTNR, but missing from db -> add to error list
                                    AddToErrorList "Mat cert not registered in db", strFile
                                
                                Else
                                    strFileSource = MakePath(txtCPathDocument, txtCFolderMat, strFile) 'original source file
                                    If Not fso.FileExists(strFileSource) Then 'present in db, but actual file missing -> add to error list
                                        AddToErrorList "Mat cert file missing", strFileSource, strDescr
                                    
                            
                                    Else
                                        AddToProjectPrint strFileDest 'add path for numbered documentation to queu
                                        If Not blnSim Then 'add to CD library
                                            acrAVDoc.Open strFileSource, strFile
                                            Set acrForm = acrFormApp.Fields
                                            'AcrobatField rst.Fields("SEQN"), "Num", "text", "48", 520, 40, 590, 90 'JVB
                                            AcrobatField rst.Fields("SEQN"), "Num", "text", "48", 500, 40, 590, 90 'JVB
                                            'AcrobatField rst.Fields("DDescription"), "Art", "text", "10", 500, 20, 590, 35
                                            Set acrPDDoc = acrAVDoc.GetPDDoc
                                            acrPDDoc.Save PDSaveFull, strFileDest
                                             acrAVDoc.Close True
'                                            acrAVDoc.Open strFileSource, strFile
'                                            acrAVDoc.BringToFront
'                                            Set acrForm = Nothing
'                                            Set acrField = Nothing
'                                            Set acrForm = acrFormApp.Fields
'                                            On Error Resume Next
'                                            'Set acrField = acrForm.Add("Num", "text", 0, 520, 20, 590, 70) 'JVB
'                                            Set acrField = acrForm.Add("Num", "text", 0, 500, 20, 590, 90) 'JVB
'                                            If Err Then
'                                                Err.Clear
'                                                AddToErrorList "Protected document", strFileSource, strDescr
'                                            Else
'                                                With acrField
'                                                    .SetForegroundColor "RGB", 1, 1, 1, 0
'                                                    .SetBackgroundColor "RGB", 0, 0, 0, 0
'                                                    .Alignment = "center"
'                                                    .TextSize = "48"
'                                                    .TextFont = "Arial"
'                                                    .Value = rst.Fields("INumber")
'                                                    .IsReadOnly = True
'                                                End With
'                                            End If
'                                            On Error GoTo ErrHandler
'
'                                            Set acrPDDoc = acrAVDoc.GetPDDoc
'                                            acrPDDoc.Save PDSaveFull, strFileDest
'                                            acrAVDoc.Close True
                                        End If
                                    End If
                                End If
                                .MoveNext
                            Loop
                            .Close
                        End With
                    End If
                    
                    'mat cert indicated by code 1,2,6,7,8 in CRTKD, but no CRTNR found
                    Set rst = dbs.OpenRecordset("SELECT ARTPF, CRTKD, CRTNR FROM tblAS400D WHERE (CRTKD='1' OR CRTKD='2' OR CRTKD>='6') AND (CRTNR Is Null OR Trim([CRTNR])='')")
                    With rst
                        If Not .EOF Then
                            .MoveLast
                            intRecordCount = .RecordCount
                            If intRecordCount > 0 Then
                                .MoveFirst
                                Do While Not .EOF
                                    AddToErrorList "Mat cert code missing in AS400 file for article number", .Fields("ARTPF")
                                    .MoveNext
                                Loop
                            End If
                        End If
                    End With
                    
                    blnMatDone = True
                End If
                
                If blnDraw Then 'drawings---------------------------------------------------------------------------
                    Set rst = dbs.OpenRecordset("SELECT DRAW, DRAWO FROM tblAS400D WHERE DRAW Is Not Null ORDER BY DRAW")
                    With rst
                        .MoveLast
                        intRecordCount = .RecordCount
                        
                        If intRecordCount > 0 Then
                            If blnSim Then
                                strCDPath = strSimPath
                            Else
                                strCDPath = MakePath(strProjectPath, "CD_" & strMachineNumber, txtCFolderCDManual, txtCFolderCDCert, txtCFolderCDDraw)
                            End If
                            strFile = "Index Drawings.xls"
                            strDocIndex = MakePath(strCDPath, strFile)
                            AddToProjectPrint strDocIndex 'index is formatted excel file
                                                                  
                            'individual drawings
                            .MoveFirst
                            Do While Not .EOF
                                strFile = Trim(.Fields("DRAW")) & ""
                                strDescr = .Fields("DRAWO") & ""
                                strFileDest = MakePath(strCDPath, strFile & " " & strDescr & ".pdf")
                                
                                With fso
                                    blnPDF = True
                                    strFilePDF = MakePath(strDrawingPDF, strFile & ".pdf")
                                    If Not .FileExists(strFilePDF) Then 'file not found, look for it on Engineering
                                        strOrgDrawing = MakePath(txtCPathDrawing, strFile & ".hp2")
                                        If .FileExists(strOrgDrawing) Then 'try full code P0ABCDEFYY.hp2 or P1ABCDEFYY.hp2 in drawing root
                                            'convert to protected pdf and transfer to validation.....................
                                            .CopyFile strOrgDrawing, MakePath(strDrawingPDF, .GetFileName(strOrgDrawing))
                                        Else
                                            strOrgDrawing = MakePath(txtCPathDrawing, Mid(strFile, 2) & ".plt")
                                            If .FileExists(strOrgDrawing) Then 'try ABCDEF.plt in drawing root
                                                'convert to protected pdf and transfer to validation.....................
                                                .CopyFile strOrgDrawing, MakePath(strDrawingPDF, .GetFileName(strOrgDrawing))
                                            Else
                                                strOrgDrawing = MakePath(txtCPathDrawing, "scan", Left(strFile, 3), Mid(strFile, 2) & ".tif")
                                                If .FileExists(strOrgDrawing) Then 'try Scan\ABC\ABCDEF.tif
                                                    'convert to protected pdf and transfer to validation.....................
                                                    .CopyFile strOrgDrawing, MakePath(strDrawingPDF, .GetFileName(strOrgDrawing))
                                                Else
                                                    blnPDF = False
                                                End If
                                            End If
                                        End If
                                    End If
                                    
                                    If blnPDF Then
                                        AddToProjectPrint strFileDest
                                        'If Not blnSim Then .CopyFile Source:=strFilePDF, Destination:=strFileDest, OverWriteFiles:=True
                                    Else
                                        AddToErrorList "Drawing missing", strFilePDF, strDescr
                                    End If
                                End With
                                .MoveNext
                            Loop
                            .Close
                        End If
                    End With
                    blnDrawDone = True
                End If
                
            End With
        
            If Not appExcel Is Nothing Then If Not blnExcelRunning Then appExcel.Quit
            If Not appWord Is Nothing Then If Not blnWordRunning Then appWord.Quit
        End If
    Next
End If

 

 

 

TOPICS
Acrobat SDK and JavaScript, Create PDFs, Edit and convert PDFs, General troubleshooting, How to

Views

74

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

Automate adding text box to PDFs: strange issue

New Here ,
Jan 08, 2020

Copy link to clipboard

Copied

Hello everyone,

 

I have an Access database with some VBA code in it that currently only works on a Windows 7 virtual machine with 32bit Office 2010 and Acrobat 8. I’m trying to get it to work on a Windows 10 machine with 64bit Office 365 and Acrobat DC. It uses cells in an Excel file to look for PDFs in a source folder, copies them to a destination folder, renames them 1.pdf, 2.pdf etcetera, and adds a text box with the correct number to the first page of the PDF.

When I press the button to do this, I get the following error:

Error number -2147221164

Description: Class not registered

which points to the following code:

image.png

 

 

 

 

When I ignore this error, the program starts copying and renaming PDFs, but does not add the text box to them. Each PDF results in the following error:

Error number 91:

Description: Object variable or With block variable not set

which points to this code:

image.png

 

Curiously, the whole process works when:

  • At least one of the destination PDFs has been created and is opened in Acrobat DC when I press the button (this will create all destination files and add text boxes to all but the opened file); or
  • The first source PDF file to be used is opened in Acrobat DC when I press the button (this creates all destination files with text boxes)

Can anyone explain this behavior? Full code below. The button executes BuildQueu (blnSim = false). The snippet that should add text boxes starts from the second image.

 

Full code (edit: some unnecessary code removed)

 

Private Sub BuildQueu(blnSim As Boolean)
Dim blnDoc As Boolean
Dim blnDocDone As Boolean
Dim blnDraw As Boolean
Dim blnDrawDone As Boolean
Dim blnExp As Boolean
Dim blnExpDone As Boolean
Dim blnMat As Boolean
Dim blnMatDone As Boolean
Dim blnPDF As Boolean

Dim intCol As Integer
Dim intGreenRow As Integer
Dim intRecordCount As Integer
Dim intRow As Integer
Dim intUnderScore As Integer

Dim strArt As String
Dim strArtExt As String
Dim strArtMem As String
Dim strCDPath As String
Dim strCR As String
Dim strDescr As String
Dim strDocFile As String
Dim strDocFileDescr As String
Dim strDocFileNoExt As String
Dim strDocIndex As String
Dim strExtraInfo As String
Dim strString As String
Dim strFileDest As String
Dim strFilePDF As String
Dim strFileSource As String
Dim strMachineNumber As String
Dim strOrgDrawing As String
Dim strDrawingPDF As String
Dim strProjectFile As String
Dim strProjectFileType As String
Dim strProjectPath As String
Dim strSimPath As String

Dim rst As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim rstIndex As DAO.Recordset
Dim docGreen As Word.Document

On Error GoTo ErrHandler
DoCmd.Hourglass True
Set dbs = CurrentDb

If StartWord Then
    cmdProjectClear_Click
    Me.Repaint
    
    If Not blnSim Then 'don't load Acrobat when just checking
        Set acrAVDoc = CreateObject("AcroExch.AVDoc")
        Set acrFormApp = CreateObject("AFormAut.App")
    End If
    
    strSimPath = MakePath(txtCPathDocument, txtCFolderPrintIndex)
    strProjectPath = MakePath(txtCPathProject, lstMachineType, lstProjectFolder)
    strDrawingPDF = MakePath(txtCPathDocument, txtCFolderDrawing)
    
    For intRow = 0 To lstProjectFile.ListCount - 1
        If lstProjectFile.Selected(intRow) Then
            strProjectFile = lstProjectFile.ItemData(intRow)
            strProjectFileType = Left(strProjectFile, 1)
            blnDoc = (strProjectFileType = "D") And chkDoc <> 0 And Not blnDocDone
            blnExp = (strProjectFileType = "D") And chkExp <> 0 And Not blnExpDone
            blnMat = (strProjectFileType = "M") And chkMat <> 0 And Not blnMatDone
            blnDraw = (strProjectFileType = "T") And chkDrawing <> 0 And Not blnDrawDone
            
            LinkAS400 MakePath(txtCPathProject, lstMachineType, lstProjectFolder, strProjectFile)
                    
            If Not blnDraw Then
                Set rst = dbs.OpenRecordset("SELECT TOP 1 * FROM tblAS400D") 'set path for CD-manual
                With rst
                    .MoveFirst
                    strMachineNumber = .Fields("SELPF") 'machine number in column A
                    .Close
                End With
            Else
                strMachineNumber = lstProjectFolder
                intUnderScore = InStr(1, strMachineNumber, "_")
                If intUnderScore Then strMachineNumber = Left(strMachineNumber, intUnderScore - 1)
            End If
            
            With appWord
                If blnDoc Then 'documentations-------------------------------------------------------------------
                    DoCmd.RunSQL "DELETE * FROM tblIndex"
                    DoCmd.OpenQuery "qryIndexDoc"
                    Set rst = dbs.OpenRecordset("qryIndexDocDescr") 'main documentation index per description
                    rst.MoveLast
                    intRecordCount = rst.RecordCount
                    
                    If intRecordCount > 0 Then
                        rst.MoveFirst
                        If blnSim Then
                            strCDPath = strSimPath
                        Else
                            strCDPath = MakePath(strProjectPath, "CD_" & strMachineNumber, txtCFolderCDDoc)
                        End If
                        strFile = "SP" & strMachineNumber & " per Description.doc"
                        strDocIndex = MakePath(strCDPath, strFile)
                        AddToProjectPrint strDocIndex
                        
                        With .Documents.Add(Template:=MakePath(txtCPathDocument, txtCFolderTemplate, "Index Documentations per Description.doc"))
                            With .Tables(1)
                                For intC = 2 To intRecordCount + 1
                                    Set docGreen = appWord.Documents.Add(Template:=MakePath(txtCPathDocument, txtCFolderTemplate, "Index Green.doc"))
                                    docGreen.Paragraphs(1).Range.InsertBefore rst.Fields("DDescription")
                                    
                                    If intC > 2 Then .Rows.Add
                                    .Cell(intC, 1).Range.InsertAfter Text:=rst.Fields("DDescription") 'description
                                    
                                    strDocFile = rst.Fields("DFileName")
                                    strDocFileNoExt = Left(strDocFile, Len(strDocFile) - 4) 'exclude extension
                                    
                                    'add article numbers to main and green documentation index
                                    intGreenRow = 2
                                    Set rst2 = dbs.OpenRecordset("SELECT DISTINCT ARTPF, ATag, AType FROM tblAS400D INNER JOIN qryArticlePlusDType ON tblAS400D.ARTPF=qryArticlePlusDType.ANumber WHERE qryArticlePlusDType.DType=1 AND DOCNR = '" & strDocFileNoExt & "' ORDER BY ARTPF")
                                    rst2.MoveFirst
                                    bln = False
                                    strArtExt = "" 'reset file name part containing art numbers
                                    strArtMem = ""
                                    Do While Not rst2.EOF
                                        strArt = rst2.Fields("ARTPF")
                                        If strArt <> strArtMem And Len(strArtExt) < 200 Then strArtExt = strArtExt & " " & strArt
                                        strArtMem = strArt
                                        If bln Then strCR = vbCr Else strCR = "" 'not first time
                                        .Cell(intC, 2).Range.InsertAfter Text:=strCR & rst2.Fields("AType")
                                        .Cell(intC, 3).Range.InsertAfter Text:=strCR & rst2.Fields("ARTPF")
                                        .Cell(intC, 4).Range.InsertAfter Text:=strCR & rst2.Fields("ATag")
                                        With docGreen.Tables(1)
                                            If bln Then .Rows.Add
                                            .Cell(intGreenRow, 1).Range.InsertAfter rst2.Fields("ARTPF") & ""
                                            .Cell(intGreenRow, 2).Range.InsertAfter rst2.Fields("ATag") & ""
                                            .Cell(intGreenRow, 3).Range.InsertAfter rst2.Fields("AType") & ""
                                        End With
                                        intGreenRow = intGreenRow + 1
                                        rst2.MoveNext
                                        bln = True
                                    Loop
                                    rst2.Close
                                                                                                
                                    .Cell(intC, 5).Range.InsertAfter Text:=intC - 1 'document number
                                    With docGreen
                                        .Bookmarks("bkmMachNumber").Range.InsertAfter strMachineNumber
                                        .Bookmarks("bkmDocNum").Range.Text = intC - 1
                                        strString = MakePath(strCDPath, "Green Index\Index " & intC - 1 & ".doc")
                                        strExtraInfo = "Error while saving " & strString
                                        .SaveAs FileName:=strString
                                        strExtraInfo = ""
                                        .Close
                                    End With
                                    With rst
                                        .Edit
                                        .Fields("INumber") = intC - 1
                                        .Update
                                        .MoveNext
                                    End With
                                Next
                                rst.Close
                            End With
                            .Bookmarks("bkmMachNumber").Range.InsertAfter strMachineNumber
                            strExtraInfo = "Error while saving " & strDocIndex
                            .SaveAs FileName:=strDocIndex
                            strExtraInfo = ""
                            .Close
                        End With
                    End If
                    
                    Set rst = dbs.OpenRecordset("qryIndexTag") 'main documentation index per tagnumber
                    rst.MoveLast 'populate recordset to establish recordcount
                    intRecordCount = rst.RecordCount
                    
                    If intRecordCount > 0 Then
                        rst.MoveFirst
                        strFile = "SP" & strMachineNumber & " per Tagnumber.doc"
                        With .Documents.Add(Template:=MakePath(txtCPathDocument, txtCFolderTemplate, "Index Documentations per Tagnumber.doc"))
                            With .Tables(1)
                                For intC = 2 To intRecordCount + 1
                                    If intC > 2 Then .Rows.Add 'index
                                    .Cell(intC, 1).Range.InsertAfter Text:=rst.Fields("ATag") & ""
                                    .Cell(intC, 2).Range.InsertAfter Text:=rst.Fields("ANumber") & ""
                                    .Cell(intC, 3).Range.InsertAfter Text:=rst.Fields("DDescription") & ""
                                    .Cell(intC, 4).Range.InsertAfter Text:=rst.Fields("AType") & ""
                                    .Cell(intC, 5).Range.InsertAfter Text:=rst.Fields("INumber") & ""
                                    rst.MoveNext
                                Next
                                rst.Close
                            End With
                            strDocIndex = MakePath(strCDPath, strFile)
                            AddToProjectPrint strDocIndex
                            .Bookmarks("bkmMachNumber").Range.InsertAfter strMachineNumber
                            strExtraInfo = "Error while saving " & strDocIndex
                            .SaveAs FileName:=strDocIndex
                            strExtraInfo = ""
                            .Close
                        End With
                                                       
                        'individual documentations
                        Set rst = dbs.OpenRecordset("SELECT IFileName, INumber, DDescription FROM tblIndex LEFT JOIN tblDocument ON tblIndex.IFileName = tblDocument.DFileName ORDER BY INumber")
                        With rst
                            .MoveFirst
                            Do While Not .EOF
                                strFile = Trim(.Fields("IFilename")) & ""
                                strDocFileNoExt = Left(strFile, Len(strFile) - 4) 'exclude extension
                                Set rst2 = dbs.OpenRecordset("SELECT DISTINCT ARTPF FROM tblAS400D WHERE DOCNR = '" & strDocFileNoExt & "' ORDER BY ARTPF")
                                With rst2
                                    If Not .EOF Then .MoveFirst
                                    strArtExt = ""
                                    Do While Not .EOF
                                        If Len(strArtExt) < 200 Then strArtExt = strArtExt & " " & Trim(.Fields("ARTPF"))
                                        .MoveNext
                                    Loop
                                End With
                                strDescr = .Fields("DDescription") & ""
                                strFileDest = MakePath(strCDPath, rst.Fields("INumber") & ".pdf")
                                
                                If strDescr = "" Then 'present in DOCNR, but missing from db
                                    AddToErrorList "Doc not registered in db", strFile

                                Else
                                    strFileSource = MakePath(txtCPathDocument, txtCFolderDoc, strFile) 'original source file
                                    If Not fso.FileExists(strFileSource) Then 'present in db, but actual file missing -> add to error list
                                        AddToErrorList "Doc file missing", strFileSource, strDescr
                                    
                                    Else 'file ok
                                        AddToProjectPrint MakePath(strCDPath, "Green Index\Index " & rst.Fields("INumber") & ".doc") 'add green index to queu
                                        AddToProjectPrint strFileDest 'add path for numbered documentation to queu
                                        If Not blnSim Then 'add to CD library
                                        
                                            acrAVDoc.Open strFileSource, strFile
                                            acrAVDoc.BringToFront
                                            Set acrForm = Nothing
                                            Set acrField = Nothing
                                            Set acrForm = acrFormApp.Fields
                                            On Error Resume Next
                                            'Set acrField = acrForm.Add("Num", "text", 0, 520, 20, 590, 70) 'JVB
                                            Set acrField = acrForm.Add("Num", "text", 0, 500, 20, 590, 90) 'JVB
                                            If Err Then
                                                Err.Clear
                                                AddToErrorList "Protected document", strFileSource, strDescr
                                            Else
                                                With acrField
                                                    .SetForegroundColor "RGB", 1, 1, 1, 0
                                                    .SetBackgroundColor "RGB", 0, 0, 0, 0
                                                    .Alignment = "center"
                                                    .TextSize = "48"
                                                    .TextFont = "Arial"
                                                    .Value = rst.Fields("INumber")
                                                    .IsReadOnly = True
                                                End With
                                            End If
                                            On Error GoTo ErrHandler
                                            
                                            Set acrPDDoc = acrAVDoc.GetPDDoc
                                            acrPDDoc.Save PDSaveFull, strFileDest
                                            acrAVDoc.Close True
                                        End If
                                    End If
                                End If
                                .MoveNext
                            Loop
                            .Close
                            strExtraInfo = ""
                        End With
                    End If
                   
                   'doc indicated by code 4,5,6,8
                    Set rst = dbs.OpenRecordset("SELECT ARTPF, CRTKD, DOCNR FROM tblAS400D WHERE (CRTKD='4' OR CRTKD='5' OR CRTKD='6' OR CRTKD='8') AND (DOCNR Is Null OR Trim([DOCNR])='')")
                    With rst
                        If Not .EOF Then
                            .MoveLast
                            intRecordCount = .RecordCount
                            If intRecordCount > 0 Then
                                .MoveFirst
                                Do While Not .EOF
                                    AddToErrorList "Documentation code missing in AS400 file for article number", .Fields("ARTPF")
                                    .MoveNext
                                Loop
                            End If
                        End If
                    End With
                        
                    blnDocDone = True
                End If
                
                If blnExp Then 'ex certificates------------------------------------------------------------------------
                    DoCmd.RunSQL "DELETE * FROM tblIndex" 'main ex certificates index per description
                    DoCmd.OpenQuery "qryIndexExp" 'fill tblIndex with ex file data
                    
                    Set rst = dbs.OpenRecordset("qryIndexExpDescr")
                    rst.MoveLast
                    intRecordCount = rst.RecordCount
                    
                    If intRecordCount > 0 Then
                        rst.MoveFirst
                        If blnSim Then
                            strCDPath = strSimPath
                        Else
                            strCDPath = MakePath(strProjectPath, "CD_" & strMachineNumber, txtCFolderCDManual, txtCFolderCDCert, txtCFolderCDExp)
                        End If
                        strFile = "EX" & strMachineNumber & ".doc"
                        strDocIndex = MakePath(strCDPath, strFile)
                        AddToProjectPrint strDocIndex
                        
                        With .Documents.Add(Template:=MakePath(txtCPathDocument, txtCFolderTemplate, "Index Ex-certificates per Description.doc"))
                            With .Tables(1)
                                For intC = 2 To intRecordCount + 1
                                    If intC > 2 Then .Rows.Add
                                    .Cell(intC, 1).Range.InsertAfter Text:=rst.Fields("DDescription") 'description
                                    
                                    strDocFile = rst.Fields("DFileName")
                                    strDocFileNoExt = Left(strDocFile, Len(strDocFile) - 4) 'exclude extension
                                    
                                    'add article, tag, type to main ex index
                                    Set rst2 = dbs.OpenRecordset("SELECT DISTINCT ARTPF FROM tblAS400D WHERE EXNR = '" & strDocFileNoExt & "' ORDER BY ARTPF")
                                    rst2.MoveFirst
                                    bln = False
                                    Do While Not rst2.EOF
                                        If bln Then strCR = vbCr Else strCR = "" 'not first time
                                        .Cell(intC, 2).Range.InsertAfter Text:=strCR & rst2.Fields("ARTPF")
                                        rst2.MoveNext
                                        bln = True
                                    Loop
                                    rst2.Close
                                    
                                    .Cell(intC, 3).Range.InsertAfter Text:=intC - 1 'document number
                                    With rst
                                        .Edit
                                        .Fields("INumber") = intC - 1
                                        .Update
                                        .MoveNext
                                    End With
                                Next
                                rst.Close
                            End With
                            .Bookmarks("bkmMachNumber").Range.InsertAfter strMachineNumber
                            strExtraInfo = "Error while saving " & strDocIndex
                            .SaveAs FileName:=strDocIndex
                            strExtraInfo = ""
                            .Close
                        End With
                                                              
                        'individual ex certificates
                        Set rst = dbs.OpenRecordset("SELECT IFileName, INumber, DDescription FROM tblIndex LEFT JOIN tblDocument ON tblIndex.IFileName = tblDocument.DFileName ORDER BY INumber")
                        With rst
                            .MoveFirst
                            Do While Not .EOF
                                strFile = Trim(.Fields("IFilename")) & ""
                                strDescr = .Fields("DDescription") & ""
                                strFileDest = MakePath(strCDPath, rst.Fields("INumber") & ".pdf")
            
                                If strDescr = "" Then 'present in EXNR, but missing from db -> add to error list
                                    AddToErrorList "Ex cert not registered in db", strFile
                                
                                Else
                                    strFileSource = MakePath(txtCPathDocument, txtCFolderExp, strFile) 'original source file
                                    If Not fso.FileExists(strFileSource) Then 'present in db, but actual file missing -> add to error list
                                        AddToErrorList "Ex cert file missing", strFileSource, strDescr
                                    
                                    Else
                                        AddToProjectPrint strFileDest 'add path for numbered ex cert queu
                                        If Not blnSim Then 'add to CD library
                                            acrAVDoc.Open strFileSource, strFile
                                            Set acrForm = acrFormApp.Fields
                                            'AcrobatField rst.Fields("INumber"), "Num", "text", "48", 520, 20, 590, 70 'JVB
                                            AcrobatField rst.Fields("INumber"), "Num", "text", "48", 500, 20, 590, 90 'JVB
                                            Set acrPDDoc = acrAVDoc.GetPDDoc
                                            acrPDDoc.Save PDSaveFull, strFileDest
                                            acrAVDoc.Close True
                                        End If
                                    End If
                                End If
                                .MoveNext
                            Loop
                            .Close
                        End With
                    End If
                    
                    'ex cert indicated by code 3,5,7,8 in CRTKD, but no EXNR found
                    Set rst = dbs.OpenRecordset("SELECT ARTPF, CRTKD, EXNR FROM tblAS400D WHERE (CRTKD='3' OR CRTKD='5' OR CRTKD>='7') AND (EXNR Is Null OR Trim([EXNR])='')")
                    With rst
                        If Not .EOF Then
                            .MoveLast
                            intRecordCount = .RecordCount
                            If intRecordCount > 0 Then
                                .MoveFirst
                                Do While Not .EOF
                                    AddToErrorList "Ex cert code missing in AS400 file for article number", .Fields("ARTPF")
                                    .MoveNext
                                Loop
                            End If
                        End If
                    End With
                    
                    blnExpDone = True
                End If
                
                If blnMat Then 'material certificates-----------------------------------------------------------------
                    Set rst = dbs.OpenRecordset("SELECT CRTNRExt, SEQN, DDescription FROM qryAS400Mat LEFT JOIN tblDocument ON qryAS400Mat.CRTNRExt = tblDocument.DFileName ORDER BY SEQN")
                    rst.MoveLast
                    intRecordCount = rst.RecordCount
                    
                    If intRecordCount > 0 Then
                        If blnSim Then
                            strCDPath = strSimPath
                        Else
                            strCDPath = MakePath(strProjectPath, "CD_" & strMachineNumber, txtCFolderCDDoc)
                            
                        End If
                        strFile = "Index Material Certificates.xls"
                        strDocIndex = MakePath(strCDPath, strFile)
                        AddToProjectPrint strDocIndex 'index is formatted excel file
                                                              
                        'individual mat certificates
                        With rst
                            .MoveFirst
                            Do While Not .EOF
                                strFile = Trim(.Fields("CRTNRExt")) & ""
                                strDescr = .Fields("DDescription") & ""
                                strFileDest = MakePath(strCDPath, rst.Fields("SEQN") & ".pdf")
            
                                If strDescr = "" Then 'present in CRTNR, but missing from db -> add to error list
                                    AddToErrorList "Mat cert not registered in db", strFile
                                
                                Else
                                    strFileSource = MakePath(txtCPathDocument, txtCFolderMat, strFile) 'original source file
                                    If Not fso.FileExists(strFileSource) Then 'present in db, but actual file missing -> add to error list
                                        AddToErrorList "Mat cert file missing", strFileSource, strDescr
                                    
                            
                                    Else
                                        AddToProjectPrint strFileDest 'add path for numbered documentation to queu
                                        If Not blnSim Then 'add to CD library
                                            acrAVDoc.Open strFileSource, strFile
                                            Set acrForm = acrFormApp.Fields
                                            'AcrobatField rst.Fields("SEQN"), "Num", "text", "48", 520, 40, 590, 90 'JVB
                                            AcrobatField rst.Fields("SEQN"), "Num", "text", "48", 500, 40, 590, 90 'JVB
                                            'AcrobatField rst.Fields("DDescription"), "Art", "text", "10", 500, 20, 590, 35
                                            Set acrPDDoc = acrAVDoc.GetPDDoc
                                            acrPDDoc.Save PDSaveFull, strFileDest
                                             acrAVDoc.Close True
'                                            acrAVDoc.Open strFileSource, strFile
'                                            acrAVDoc.BringToFront
'                                            Set acrForm = Nothing
'                                            Set acrField = Nothing
'                                            Set acrForm = acrFormApp.Fields
'                                            On Error Resume Next
'                                            'Set acrField = acrForm.Add("Num", "text", 0, 520, 20, 590, 70) 'JVB
'                                            Set acrField = acrForm.Add("Num", "text", 0, 500, 20, 590, 90) 'JVB
'                                            If Err Then
'                                                Err.Clear
'                                                AddToErrorList "Protected document", strFileSource, strDescr
'                                            Else
'                                                With acrField
'                                                    .SetForegroundColor "RGB", 1, 1, 1, 0
'                                                    .SetBackgroundColor "RGB", 0, 0, 0, 0
'                                                    .Alignment = "center"
'                                                    .TextSize = "48"
'                                                    .TextFont = "Arial"
'                                                    .Value = rst.Fields("INumber")
'                                                    .IsReadOnly = True
'                                                End With
'                                            End If
'                                            On Error GoTo ErrHandler
'
'                                            Set acrPDDoc = acrAVDoc.GetPDDoc
'                                            acrPDDoc.Save PDSaveFull, strFileDest
'                                            acrAVDoc.Close True
                                        End If
                                    End If
                                End If
                                .MoveNext
                            Loop
                            .Close
                        End With
                    End If
                    
                    'mat cert indicated by code 1,2,6,7,8 in CRTKD, but no CRTNR found
                    Set rst = dbs.OpenRecordset("SELECT ARTPF, CRTKD, CRTNR FROM tblAS400D WHERE (CRTKD='1' OR CRTKD='2' OR CRTKD>='6') AND (CRTNR Is Null OR Trim([CRTNR])='')")
                    With rst
                        If Not .EOF Then
                            .MoveLast
                            intRecordCount = .RecordCount
                            If intRecordCount > 0 Then
                                .MoveFirst
                                Do While Not .EOF
                                    AddToErrorList "Mat cert code missing in AS400 file for article number", .Fields("ARTPF")
                                    .MoveNext
                                Loop
                            End If
                        End If
                    End With
                    
                    blnMatDone = True
                End If
                
                If blnDraw Then 'drawings---------------------------------------------------------------------------
                    Set rst = dbs.OpenRecordset("SELECT DRAW, DRAWO FROM tblAS400D WHERE DRAW Is Not Null ORDER BY DRAW")
                    With rst
                        .MoveLast
                        intRecordCount = .RecordCount
                        
                        If intRecordCount > 0 Then
                            If blnSim Then
                                strCDPath = strSimPath
                            Else
                                strCDPath = MakePath(strProjectPath, "CD_" & strMachineNumber, txtCFolderCDManual, txtCFolderCDCert, txtCFolderCDDraw)
                            End If
                            strFile = "Index Drawings.xls"
                            strDocIndex = MakePath(strCDPath, strFile)
                            AddToProjectPrint strDocIndex 'index is formatted excel file
                                                                  
                            'individual drawings
                            .MoveFirst
                            Do While Not .EOF
                                strFile = Trim(.Fields("DRAW")) & ""
                                strDescr = .Fields("DRAWO") & ""
                                strFileDest = MakePath(strCDPath, strFile & " " & strDescr & ".pdf")
                                
                                With fso
                                    blnPDF = True
                                    strFilePDF = MakePath(strDrawingPDF, strFile & ".pdf")
                                    If Not .FileExists(strFilePDF) Then 'file not found, look for it on Engineering
                                        strOrgDrawing = MakePath(txtCPathDrawing, strFile & ".hp2")
                                        If .FileExists(strOrgDrawing) Then 'try full code P0ABCDEFYY.hp2 or P1ABCDEFYY.hp2 in drawing root
                                            'convert to protected pdf and transfer to validation.....................
                                            .CopyFile strOrgDrawing, MakePath(strDrawingPDF, .GetFileName(strOrgDrawing))
                                        Else
                                            strOrgDrawing = MakePath(txtCPathDrawing, Mid(strFile, 2) & ".plt")
                                            If .FileExists(strOrgDrawing) Then 'try ABCDEF.plt in drawing root
                                                'convert to protected pdf and transfer to validation.....................
                                                .CopyFile strOrgDrawing, MakePath(strDrawingPDF, .GetFileName(strOrgDrawing))
                                            Else
                                                strOrgDrawing = MakePath(txtCPathDrawing, "scan", Left(strFile, 3), Mid(strFile, 2) & ".tif")
                                                If .FileExists(strOrgDrawing) Then 'try Scan\ABC\ABCDEF.tif
                                                    'convert to protected pdf and transfer to validation.....................
                                                    .CopyFile strOrgDrawing, MakePath(strDrawingPDF, .GetFileName(strOrgDrawing))
                                                Else
                                                    blnPDF = False
                                                End If
                                            End If
                                        End If
                                    End If
                                    
                                    If blnPDF Then
                                        AddToProjectPrint strFileDest
                                        'If Not blnSim Then .CopyFile Source:=strFilePDF, Destination:=strFileDest, OverWriteFiles:=True
                                    Else
                                        AddToErrorList "Drawing missing", strFilePDF, strDescr
                                    End If
                                End With
                                .MoveNext
                            Loop
                            .Close
                        End If
                    End With
                    blnDrawDone = True
                End If
                
            End With
        
            If Not appExcel Is Nothing Then If Not blnExcelRunning Then appExcel.Quit
            If Not appWord Is Nothing Then If Not blnWordRunning Then appWord.Quit
        End If
    Next
End If

 

 

 

TOPICS
Acrobat SDK and JavaScript, Create PDFs, Edit and convert PDFs, General troubleshooting, How to

Views

75

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
Jan 08, 2020 0
Most Valuable Participant ,
Jan 08, 2020

Copy link to clipboard

Copied

My, that's a lot of code. Nobody's going to read that, for sure...

Anyway, please check on the problem machine: what is your exact Acrobat version (not "latest" please)? And, is it Acrobat Reader, Acrobat Pro or Acrobat Standard?

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...
Jan 08, 2020 0
Most Valuable Participant ,
Jan 08, 2020

Copy link to clipboard

Copied

Hmm, also... does it work if you have already opened an ENTIRELY UNRELATED PDF in Acrobat?

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...
Jan 08, 2020 0
MHE1 LATEST
New Here ,
Jan 08, 2020

Copy link to clipboard

Copied

It does not, the same sequence of errors occurs and I get no text boxes.

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...
Jan 08, 2020 0
New Here ,
Jan 08, 2020

Copy link to clipboard

Copied

I know it's a ton of code, I did not write it and I'm such a novice I don't know if I could have left anything out...

 

The exact Acrobat version is Pro DC 2019.021.20061.

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...
Jan 08, 2020 0