New Here
,
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:
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:
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
4
Replies
4
4
Replies
AdChoices