Frothingslosh
Premier Pale Stale Ale
- Local time
 - Today, 05:53
 
- 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?