Frothingslosh
Premier Pale Stale Ale
- Local time
- Yesterday, 21:35
- Joined
- Oct 17, 2012
- Messages
- 3,276
Okay, so I'm exporting the results of a query to a fillable PDF and saving them to a different folder. Null sweat, right?
The problem I'm running into is this:
My first two files generate just fine, but the third one kicks back a Type Mismatch error. I've determined which line it is (the PO Number line), and here's the weird part:
From testing, I have determined:
I'll include the code below. Not included is the calling code, but all that does is open a recordset and pass it to the function. The recordset is accurate and working as expected. Forgive the over-documentation - this is actually supported by someone else who isn't all that skilled with VBA.
So my question is this: Does anyone have a freaking clue what is causing this intermittent error and how to fix it?
The problem I'm running into is this:
My first two files generate just fine, but the third one kicks back a Type Mismatch error. I've determined which line it is (the PO Number line), and here's the weird part:
- File one has a null value in PO Number and exports just fine.
- File two has a value in PO Number, so no issues.
- File three has a null value in PO Number, and kicks off the error.
From testing, I have determined:
- If I immediately run the code again, files 1 and 2 are skipped, and file 3 exports perfectly fine.
- If I don't do an Nz check and just force a value, file 3 exports with no issues.
- It doesn't actually matter what I use as the second argument in the Nz - it ALWAYS kicks back an error for file 3 at the PO Number line.
I'll include the code below. Not included is the calling code, but all that does is open a recordset and pass it to the function. The recordset is accurate and working as expected. Forgive the over-documentation - this is actually supported by someone else who isn't all that skilled with VBA.
Code:
Private Function CreateBadgeRequests(ByRef rs As DAO.Recordset, _
Optional ByVal IsBatch As Boolean = False) As Long
[COLOR="SeaGreen"]' ************************************************************
' Created by: Scott L Prince
' Created on: 2019-03-11
' Parameters: rs - Recordset containing the request information
' IsBatch (OPTIONAL) - Indicates whether or not this is a batch request rather than individual requests.
' Results: Creates one or more badge requests in the form of PDF files.
' Returns: 0 - Unhandled exception
' 1 - Completed successfully
' 2 - Error encountered and trapped, user notified
' Remarks: Based on code created by Access MVP Leo (theDBGuy).
' http://www.accessmvp.com/thedbguy
' https://thedbguy.blogspot.com
' ************************************************************
[/COLOR]
[COLOR="seagreen"]'Adobe PDF Save enumeration. Combine using OR to use multiple flags.[/COLOR]
Const PDSaveIncremental = 0 [COLOR="seagreen"]'Incremental save - saves original plus changes. Always larger than original.[/COLOR]
Const PDSaveFull = 1 [COLOR="seagreen"]'Creates a new save file.[/COLOR]
Const PDSaveCopy = 2 [COLOR="seagreen"]'Requires PDSaveFull. Saves a copy and leaves original untouched.[/COLOR]
Const PDSaveCollectGarbage = 32 [COLOR="seagreen"] 'Requires PDSaveFull. Removes unreferenced objects.[/COLOR]
Const PDSaveLinearized = 4 [COLOR="seagreen"]'Requires PDSaveFull. Used to save web documents.[/COLOR]
[COLOR="seagreen"]'*** LATE BINDING ***[/COLOR]
Dim AcroAppl As Object
Dim AcroDoc As Object
Dim pdfDoc As Object
[COLOR="seagreen"]'*** EARLY BINDING - ADOBE REFERENCE LIBRARY MUST BE ENABLED TO USE THESE ***
'Dim AcroAppl As AcroApp
'Dim AcroDoc As AcroAVDoc
'Dim pdfDoc As AcroPDDoc
'OTHER OBJECT VARIABLES[/COLOR]
Dim db As DAO.Database
Dim jso As Object [COLOR="seagreen"] 'JavaScript object. Created from Adobe library - no native VBA object, so MUST be late-bound.[/COLOR]
[COLOR="seagreen"]'DATA VARIABLES[/COLOR]
Dim PDSaveOptions As Long
Dim TemplatePath As String
Dim OutputPath As String
On Error GoTo ErrHandler
PDSaveOptions = PDSaveFull Or PDSaveCopy [COLOR="seagreen"]'Use PDSaveFull and PDSaveCopy[/COLOR]
[COLOR="seagreen"]'Fillable PDF template[/COLOR]
TemplatePath = AddEndSlash(BADGE_REQUEST_TEMPLATE_PATH) & BADGE_REQUEST_TEMPLATE_NAME
[COLOR="seagreen"]'Confirm template file exists.[/COLOR]
If Dir(TemplatePath) = "" Then
[COLOR="seagreen"]'File is missing. Notify user to contact OPM.[/COLOR]
Beep
MsgBox "The template file '" & TemplatePath & "' cannot be found!" & vbCrLf & vbCrLf & _
"Please contact OPM for support.", vbCritical, "Business Partner Tracking"
Else
If Not rs.EOF Then
[COLOR="seagreen"]'Create Acrobat object.[/COLOR]
Set AcroAppl = CreateObject("AcroExch.App")
[COLOR="seagreen"]'Create Acrobat document.[/COLOR]
Set AcroDoc = CreateObject("AcroExch.AVDoc")
[COLOR="seagreen"]'Create the PDF.[/COLOR]
If AcroDoc.Open(TemplatePath, "") Then
With rs
Do
[COLOR="seagreen"]'Set the export path and file name.[/COLOR]
OutputPath = AddEndSlash(BADGE_REQUEST_OUTPUT_PATH)
If IsBatch Then
OutputPath = OutputPath & BADGE_REQUEST_BATCH_OUTPUT_NAME
Else
OutputPath = OutputPath & BADGE_REQUEST_OUTPUT_NAME & " For " & .Fields("FirstName") & " " & .Fields("LastName") & ".pdf"
End If
If Dir(OutputPath) <> "" Then
[COLOR="seagreen"]'Notify the user that the file already exists, then move to the next item.[/COLOR]
MsgBox "The file " & OutputPath & " already exists!" & vbCrLf & vbCrLf & _
"This file will NOT be created.", vbInformation, "Business Partner Tracking"
Else
[COLOR="seagreen"]'Access the PDF.[/COLOR]
Set pdfDoc = AcroDoc.GetPDDoc()
[COLOR="seagreen"]'Update form fields.
'Note that ALL fields must be checked for NULLS. If Adobe receives a null value, it generates a fatal error.[/COLOR]
Set jso = pdfDoc.GetJSObject
jso.GetField("Badge Number").Value = Nz(.Fields("BadgeNumber").Value, "")
jso.GetField("First Name").Value = Nz(.Fields("FirstName").Value, "")
jso.GetField("Last Name").Value = Nz(.Fields("LastName").Value, "")
jso.GetField("SSN last 5").Value = Nz(.Fields("LastFiveSSN").Value, "")
jso.GetField("Vendor Name").Value = Nz(.Fields("Business Partner Name").Value)
jso.GetField("Leader Badge Number").Value = Nz(.Fields("BCBSM Leader Badge ID").Value, "")
jso.GetField("Leader Name").Value = Nz(.Fields("BCBSM Leader Full Name").Value, "")
jso.GetField("Leader Phone Number").Value = Nz(.Fields("BCBSM Leader Phone Number").Value, "")
jso.GetField("Cost Center").Value = Nz(.Fields("BCBSM Leader Cost Center").Value, "")
jso.GetField("Start Date").Value = CStr(.Fields("Start Date").Value)
jso.GetField("End Date").Value = CStr(.Fields("End Date").Value)
[B][COLOR="Red"]jso.GetField("PO Number").Value = Nz(.Fields("PO Number").Value, "")[/COLOR][/B]
jso.GetField("Former Employee").Value = Nz(.Fields("Former Employee").Value, "")
jso.GetField("Primary Location").Value = Nz(.Fields("BCBSMPrimaryLocation").Value, "")
jso.GetField("Department Name").Value = Nz(.Fields("BCBSM Leader Department Name").Value, "")
jso.GetField("Mail Code").Value = Nz(.Fields("BCBSM Leader Mail Code").Value, "")
jso.GetField("Comments").Value = Nz(.Fields("Comments").Value, "")
[COLOR="seagreen"]'Save a COPY of the modified file.[/COLOR]
pdfDoc.Save PDSaveOptions, OutputPath
[COLOR="seagreen"]'Clear the document reference for the next file.[/COLOR]
Set pdfDoc = Nothing
End If 'Output file exists check
[COLOR="seagreen"]'Next record[/COLOR]
.MoveNext
Loop Until .EOF
End With
[COLOR="seagreen"]'Return success code.[/COLOR]
CreateBadgeRequests = 1
End If [COLOR="seagreen"]'AcroDoc.Open check[/COLOR]
End If [COLOR="seagreen"] 'rs.EOF check[/COLOR]
End If [COLOR="seagreen"] 'Template exists check[/COLOR]
ProcExit:
On Error Resume Next
If Not jso Is Nothing Then Set jso = Nothing
If Not pdfDoc Is Nothing Then Set pdfDoc = Nothing
If Not AcroDoc Is Nothing Then
AcroDoc.Close (True)
Set AcroDoc = Nothing
End If
If Not AcroAppl Is Nothing Then Set AcroAppl = Nothing
If Not db Is Nothing Then Set db = Nothing
Exit Function
ErrHandler:
CreateBadgeRequests = 2
Beep
MsgBox "An error has been encountered! Please notify OPM with the following information:" & vbCrLf & vbCrLf & _
"Tool Name:" & vbTab & "Business Partner Tracking" & vbCrLf & _
"Procedure:" & vbTab & Me.Name & ".CreateBadgeRequests" & vbCrLf & _
"Error Number:" & vbTab & Err.Number & vbCrLf & _
"Description:" & vbTab & Err.Description, vbCritical, "Business Partner Tracking"
Resume ProcExit
End Function
So my question is this: Does anyone have a freaking clue what is causing this intermittent error and how to fix it?