Batch Insert Problem help

[catalepticstate]

Hi all,
I am not a access vba programmer, the last time I touched it was almost 8-10 years ago.

I have been stuck with a task to insert results into a table.

I need your help as I do not understand.

The instructions are:
We need JobNo to be incremented only after each job is sent and sequence to be reset at start of job e.g.

START
1.1
1.2
1.3
NEW JOB
2.1
2.2
2.3

This allows Jobs to be managed effectively by the Print Spooler program i.e. start, stop, re-print delete. cancel etc.


Quote:
First up.

If PrintSpooler Mode
YOUR CODE
Else
Do what went before
EndIf

You should be writing code to:

Determine next JobNo + 1
Open Forward Only Snapshot RecordSet (lets call it 'Records') ON
SELECT 2 AS Expr1, 2 AS Expr2, [Tbl_Workstation Settings].Directory, dbo_Tbl_Visitors.Visitor_ID, Now() AS Expr3


FROM dbo_Tbl_Visitors LEFT JOIN [Tbl_Workstation Settings] ON dbo_Tbl_Visitors.Show_ID = [Tbl_Workstation Settings].[Show ID]
WHERE dbo_Tbl_Visitors.Visitor_ID = strCriteria;

Open Dynamic RecordSet on PrintSpooler table
Set SequenceNo = 1
Loop on Records till EOF
Insert record in PrintSpooler RecordSet
Increment SequenceNo
EndLoop
Update/Commit
Close RecordSet


this is what i have done:

Sub Go_Print_Badges(intPrintType, strCriteria, str_Mode, str_Size)
Dim nJobNo As Integer
Dim nSequenceNo As Integer
Dim rstSpool As Recordset
Dim Records As Recordset
Dim nRecordNumber As Integer

    
    If bln_Use_Print_Spooler Then
    nJobNo = nJobNo + 1
    
    Set Records = CurrentDb.OpenRecordset("SELECT [Visitor_ID] FROM dbo_Tbl_Visitors LEFT JOIN [Tbl_Workstation Settings] ON dbo_Tbl_Visitors.Show_ID = [Tbl_Workstation Settings].[Show ID] WHERE " & strCriteria & ";")
    nRecordNumber = " & [Visitor_ID] & "
    ' Open Dynamic Recordset for Spooler.mdb
    Set rstSpool = CurrentDb.OpenRecordset("SELECT JobNo, SequenceNo, [Database], RecordNumber, SubmittedTimestamp FROM RegPrintQueue")
    
    nSequenceNo = 1
        Do Until rstSpool.EOF
    rstSpool.AddNew
            rstSpool.JobNo = nJobNo
            rstSpool.SequenceNo = nSequenceNo
            rstSpool.Database = "S:"
            rstSpool.RecordNumber = " & nRecordNumber & "
            rstSpool.SubmittedTimestamp = Now()
                       
'            CurrentDb.Execute "INSERT INTO RegPrintQueue ( JobNo, SequenceNo, [Database], RecordNumber, SubmittedTimestamp )" & _
'"SELECT nJobNo, nSequenceNo, [Tbl_Workstation Settings].Directory, dbo_Tbl_Visitors.Visitor_ID, Now() " & _
'"FROM dbo_Tbl_Visitors LEFT JOIN [Tbl_Workstation Settings] ON dbo_Tbl_Visitors.Show_ID = [Tbl_Workstation Settings].[Show ID] WHERE " & strCriteria & ";"

    rstSpool.Update
    
            nSequenceNo = nSequenceNo + 1
            rstSpool.MoveNext
        Loop
    rstSpool.Close
 
    Else
        Select Case str_Mode
            Case "BATCH"
                DoCmd.OpenReport "Batch Print Badge " & str_Size, intPrintType, , strCriteria
            Case "SINGLE"
                DoCmd.OpenReport "Badge " & str_Size, intPrintType, , strCriteria
        End Select
    End If
End Sub

[June7]

Okay, you have code. What is your question? What problem have you encountered with this code - error message, wrong results, nothing happens? Have you step debugged - follow the code as it executes, find where it deviates from expectations, fix, repeat.

[catalepticstate]

Hi,
Sorry I was not clear.

The code I have does not work, I have a missing parameter missing on the first sql statement:

Set Records = CurrentDb.OpenRecordset("SELECT [Visitor_ID] FROM dbo_Tbl_Visitors LEFT JOIN [Tbl_Workstation Settings] ON dbo_Tbl_Visitors.Show_ID = [Tbl_Workstation Settings].[Show ID] WHERE " & strCriteria & ";")

It says its expecting 1

I need this code to work, if I remove strCriteria and put in :

[Show ID] = 1 AND [Visitor ID] = 2013

It goes thru all the process but does not insert the data into:

rstSpool.AddNew
rstSpool.JobNo = nJobNo
rstSpool.SequenceNo = nSequenceNo
rstSpool.Database = "S:"
rstSpool.RecordNumber = " & nRecordNumber & "
rstSpool.SubmittedTimestamp = Now()

' CurrentDb.Execute "INSERT INTO RegPrintQueue ( JobNo, SequenceNo, [Database], RecordNumber, SubmittedTimestamp )" & _
'"SELECT nJobNo, nSequenceNo, [Tbl_Workstation Settings].Directory, dbo_Tbl_Visitors.Visitor_ID, Now() " & _
'"FROM dbo_Tbl_Visitors LEFT JOIN [Tbl_Workstation Settings] ON dbo_Tbl_Visitors.Show_ID = [Tbl_Workstation Settings].[Show ID] WHERE " & strCriteria & ";"

rstSpool.Update

It just completes without inserting.

[ssanfu]

The code I have does not work, <snip>

I am not trying to be mean, but there is sooooo much wrong with your code.... so I re-wrote it. Of course it is untested, but it should work.


So to fix the criteria problem, I added a message box to see what parameters are being passed. The message box can be removed after the problem is solved.

I am unsure where you get a couple of values. Where do the values for "bln_Use_Print_Spooler" and "nJobNo" come from??

We need JobNo to be incremented only after each job is sent

Do you store the next job number or look it up from the table "RegPrintQueue"???




Here is the code:

Sub Go_Print_Badges(intPrintType As Integer, strCriteria As String, str_Mode As String, str_Size As String)
   Dim nJobNo As Integer
   Dim nSequenceNo As Integer
   Dim rstSpool As Recordset
   Dim Records As Recordset
   Dim nRecordNumber As Integer
   Dim sSQL As String

   '-----------------------------
   ' comment out/remove the msgbox after debug complete
   MsgBox "intPrintType = " & intPrintType & vbCrLf & _
          "strCriteria = " & strCriteria & vbCrLf & _
          "str_Mode = " & str_Mode & vbCrLf & _
          "str_Size = " & str_Size & vbCrLf
   '-----------------------------

   If bln_Use_Print_Spooler Then
      nJobNo = nJobNo + 1

      sSQL = "SELECT [Visitor_ID]"
      sSQL = sSQL & " FROM dbo_Tbl_Visitors LEFT JOIN [Tbl_Workstation Settings]"
      sSQL = sSQL & " ON dbo_Tbl_Visitors.Show_ID = [Tbl_Workstation Settings].[Show ID]"
      sSQL = sSQL & " WHERE " & strCriteria & ";"
      '  Debug.Print sSQL
      Set Records = CurrentDb.OpenRecordset(sSQL, , dbForwardOnly)

      ' check for records
      If Not Records.BOF And Not Records.EOF Then
         Records.MoveLast
         Records.MoveFirst

         '---------------
         'comment out later
         MsgBox "There are " & Records.RecordCount & " records to process"
         '---------------
         
         ' Open Dynamic Recordset for Spooler.mdb
         sSQL = "SELECT JobNo, SequenceNo, [Database], RecordNumber, SubmittedTimestamp"
         sSQL = sSQL & " FROM RegPrintQueue"
         Set rstSpool = CurrentDb.OpenRecordset(sSQL, , dbAppendOnly)

         nSequenceNo = 1
         Do Until Records.EOF
            nRecordNumber = Records.Fields("Visitor_ID")

            rstSpool.AddNew
            rstSpool.JobNo = nJobNo
            rstSpool.SequenceNo = nSequenceNo
            rstSpool.Database = "S:"
            rstSpool.RecordNumber = nRecordNumber  'visitor ID
            rstSpool.SubmittedTimestamp = Now()
            rstSpool.Update

            '---------------------------------------------
            'This is an alternate way to insert records into a table
            '            sSQL = "INSERT INTO RegPrintQueue ( JobNo, SequenceNo, [Database], RecordNumber, SubmittedTimestamp )"
            '            sSQL = sSQL & " VALUES (" & nJobNo & ", " & nSequenceNo & ", 'S:', " & nRecordNumber & ", #" & Now() & "#;"
            '            '            Debug.Print sSQL
            '            CurrentDb.Execute sSQL, dbFailOnError
            '---------------------------------------------

            nSequenceNo = nSequenceNo + 1
            Records.MoveNext   'the "Records" recordset is the source
         Loop

         rstSpool.Close
         Records.Close
         Set rstSpool = Nothing
         Set Records = Nothing

      End If
   Else
      Select Case str_Mode
      Case "BATCH"
         DoCmd.OpenReport "Batch Print Badge " & str_Size, intPrintType, , strCriteria
      Case "SINGLE"
         DoCmd.OpenReport "Badge " & str_Size, intPrintType, , strCriteria
      End Select
   End If

[catalepticstate]

I am not trying to be mean, but there is sooooo much wrong with your code.... so I re-wrote it. Of course it is untested, but it should work.

Thats ok, I have not worked with Access and VBA in a very long time.

So to fix the criteria problem, I added a message box to see what parameters are being passed. The message box can be removed after the problem is solved.

I am unsure where you get a couple of values. Where do the values for "bln_Use_Print_Spooler" and "nJobNo" come from??

bln_Use_Print_Spooler is set in another form and added to a table so its available if true

nJobNo is created in this sub and I need it to increment each time 1 value

Do you store the next job number or look it up from the table "RegPrintQueue"???

Yes, the table RegPrintQueue has JobNo as Primary key but is not Auto incrementing.

SequenenceNo is also the same but is not primary key




Here is the code:

Sub Go_Print_Badges(intPrintType As Integer, strCriteria As String, str_Mode As String, str_Size As String)
   Dim nJobNo As Integer
   Dim nSequenceNo As Integer
   Dim rstSpool As Recordset
   Dim Records As Recordset
   Dim nRecordNumber As Integer
   Dim sSQL As String
 
   '-----------------------------
   ' comment out/remove the msgbox after debug complete
   MsgBox "intPrintType = " & intPrintType & vbCrLf & _
          "strCriteria = " & strCriteria & vbCrLf & _
          "str_Mode = " & str_Mode & vbCrLf & _
          "str_Size = " & str_Size & vbCrLf
   '-----------------------------
 
   If bln_Use_Print_Spooler Then
      nJobNo = nJobNo + 1
 
      sSQL = "SELECT [Visitor_ID]"
      sSQL = sSQL & " FROM dbo_Tbl_Visitors LEFT JOIN [Tbl_Workstation Settings]"
      sSQL = sSQL & " ON dbo_Tbl_Visitors.Show_ID = [Tbl_Workstation Settings].[Show ID]"
      sSQL = sSQL & " WHERE " & strCriteria & ";"
      '  Debug.Print sSQL
      Set Records = CurrentDb.OpenRecordset(sSQL, , dbForwardOnly)
 
      ' check for records
      If Not Records.BOF And Not Records.EOF Then
         Records.MoveLast
         Records.MoveFirst
 
         '---------------
         'comment out later
         MsgBox "There are " & Records.RecordCount & " records to process"
         '---------------
 
         ' Open Dynamic Recordset for Spooler.mdb
         sSQL = "SELECT JobNo, SequenceNo, [Database], RecordNumber, SubmittedTimestamp"
         sSQL = sSQL & " FROM RegPrintQueue"
         Set rstSpool = CurrentDb.OpenRecordset(sSQL, , dbAppendOnly)
 
         nSequenceNo = 1
         Do Until Records.EOF
            nRecordNumber = Records.Fields("Visitor_ID")
 
            rstSpool.AddNew
            rstSpool.JobNo = nJobNo
            rstSpool.SequenceNo = nSequenceNo
            rstSpool.Database = "S:"
            rstSpool.RecordNumber = nRecordNumber  'visitor ID
            rstSpool.SubmittedTimestamp = Now()
            rstSpool.Update
 
            '---------------------------------------------
            'This is an alternate way to insert records into a table
            '            sSQL = "INSERT INTO RegPrintQueue ( JobNo, SequenceNo, [Database], RecordNumber, SubmittedTimestamp )"
            '            sSQL = sSQL & " VALUES (" & nJobNo & ", " & nSequenceNo & ", 'S:', " & nRecordNumber & ", #" & Now() & "#;"
            '            '            Debug.Print sSQL
            '            CurrentDb.Execute sSQL, dbFailOnError
            '---------------------------------------------
 
            nSequenceNo = nSequenceNo + 1
            Records.MoveNext   'the "Records" recordset is the source
         Loop
 
         rstSpool.Close
         Records.Close
         Set rstSpool = Nothing
         Set Records = Nothing
 
      End If
   Else
      Select Case str_Mode
      Case "BATCH"
         DoCmd.OpenReport "Batch Print Badge " & str_Size, intPrintType, , strCriteria
      Case "SINGLE"
         DoCmd.OpenReport "Badge " & str_Size, intPrintType, , strCriteria
      End Select
   End If

I'll test this code and get back to you.
Thank you

[ssanfu]

bln_Use_Print_Spooler is set in another form and added to a table so its available if true

Then you *should* need a reference to that form to get the value. Something like:

If Forms![YourFormNmae].bln_Use_Print_Spooler Then

(Of course, that form would need to be open to get the value.....)

[June7]

For debugging purpose, use a variable for the SQL statement. Then step debug and check that the string constructed properly. You don't show code that constructs strCriteria.

These two lines are odd to me. Why the ampersands and quote marks?
nRecordNumber = " & [Visitor_ID] & "
rstSpool.RecordNumber = " & nRecordNumber & "

When I need a value from a recordset I use the recordset name as qualifier, like:
nRecordNumber = Records!Visitor_ID

EDIT: I was composing when ssanfu posted. Think suggested revision is in line with where I was heading.

[catalepticstate]

I can't run your code as my save sub is looking for the badge size which is: str_Size

I get this error: ByRef argument type mismatch

[June7]

This 'save sub' is another procedure? Show that code.

[catalepticstate]

Save Sub

Public Sub Save_Record(lngVisitor_ID As Long, Optional ByVal boPrint As Boolean = True)
    Const Duplicate_Error = 3022
    On Error GoTo Save_Record_Err
    Dim intDemographics    As Integer
    Dim boDemographic      As Boolean
    Dim strSearch_Criteria As String
    Dim varOptions         As Variant
    Dim intOption          As Integer
    Dim intAnswer          As Integer
    Dim strMessage_Text    As String
    Dim strMessage_Title   As String
    Dim varField_Format    As Variant
    Dim strExtra_Criteria  As String
    Dim boPrint_Badge      As Boolean
    Dim strSql             As String
    Dim SubForm            As Form
    If IsLoaded("Frm_Input") Then
        With Forms!Frm_Input
            If Not Check_Details() Then Exit Sub
            If boPrint Then
                If boOnSite And boNew_Visitor Then
                    strMessage_Text = "Do you want to print a badge for this person?@" & _
                                      "'OK' will update the database and print a badge;" & vbCrLf & _
                                      "'Cancel' will allow you to make further changes to this record.@"
                    strMessage_Title = "Save and Print Badge for Visitor ID " & ![Visitor ID]
                    Beep
                    intAnswer = MsgBox(strMessage_Text, vbQuestion + vbOKCancel, strMessage_Title)
                    If intAnswer = vbOK Then intAnswer = vbYes
                Else
                    strMessage_Text = "Do you want to print a badge for this person?@" & _
                                      "'Yes' will update the database and print a badge;" & vbCrLf & _
                                      "'No' will update the data without printing a badge;" & vbCrLf & _
                                      "'Cancel' allows you to make changes to this screen before updating the data.@"
                    strMessage_Title = "Update to Visitor ID " & ![Visitor ID]
                    Beep
                    intAnswer = MsgBox(strMessage_Text, vbQuestion + vbYesNoCancel, strMessage_Title)
                End If
            Else
                intAnswer = vbNo
            End If
    
            DoCmd.Hourglass True
            If intAnswer <> vbCancel Then
                rstVisitors.FindFirst "[Visitor ID] = " & ![Visitor ID]
                If rstVisitors.NoMatch Then
                    ![Badge ID] = Badge_ID_Rule(!Surname, ![Visitor ID])
                    'New visitor record
                    rstVisitors.AddNew
                    rstVisitors![Show ID] = lngShow_ID
                    rstVisitors![Visitor ID] = ![Visitor ID]
                    rstVisitors![Badge ID] = ![Badge ID]
                    Create_Flag
                Else
                    'Existing visitor record
                    If boNew_Visitor Then
                        Do
                            Get_Next_BadgeID
                            rstVisitors.FindFirst "[Visitor ID] = " & ![Visitor ID]
                        Loop Until rstVisitors.NoMatch
                        
                        ![Badge ID] = Badge_ID_Rule(!Surname, ![Visitor ID])
                        'New visitor record
                        rstVisitors.AddNew
                        rstVisitors![Show ID] = lngShow_ID
                        rstVisitors![Visitor ID] = ![Visitor ID]
                        rstVisitors![Badge ID] = ![Badge ID]
                        Create_Flag
                    Else
                        rstVisitors.Edit
                    End If
                    rstFlags.FindFirst "[Visitor ID] = " & ![Visitor ID]
                    If rstFlags.NoMatch Then
                        Create_Flag
                    Else
                        rstFlags.Edit
                        rstFlags![Updated] = Now()
                    End If
                    If intAnswer = vbYes And boOnSite And ![Visitor Status] = igcPreReg Then
                        ![Visitor Status] = igcPreRegAttendee
                    End If
                    If DateDiff("d", rstSettings![Start of Show], Date) >= 0 Then
                        'Keep Visitor Entry records up-to-date
                        CurrentDb.Execute "UPDATE dbo_Tbl_Visitor_Entry" & _
                                          "   SET Visitor_Type = " & ![Visitor Type] & _
                                          " WHERE Show_ID = " & lngShow_ID & _
                                          "   AND Barcode = '" & ![Badge ID] & "'" & _
                                          "   AND Visitor_Type <> " & ![Visitor Type], dbFailOnError
                    End If
                End If
                rstVisitors![Title] = ![Title]
                rstVisitors![Forename] = ![Forename]
                rstVisitors![Surname] = ![Surname]
                rstVisitors![Job Title] = ![Job Title]
                rstVisitors![Department] = ![Department]
                rstVisitors![Company] = ![Company]
                rstVisitors![Company2] = ![Company2]
                rstVisitors![Post Code] = ![Post Code]
                rstVisitors![Address Line 0] = ![Address 0]
                rstVisitors![Address Line 1] = ![Address 1]
                rstVisitors![Address Line 2] = ![Address 2]
                rstVisitors![Address Line 3] = ![Address 3]
                rstVisitors![Address Line 4] = ![Address 4]
                rstVisitors![Country Name] = ![Country]
                rstVisitors![Phone No] = ![Phone]
                rstVisitors![Fax No] = ![Fax]
                rstVisitors![E-Mail] = ![E-Mail]
                rstVisitors![Mobile_No] = ![Mobile_No]
                rstFlags![Type ID] = ![Visitor Type]
                rstFlags![Status ID] = ![Visitor Status]
                'rstFlags![Purchasing Authority] = Val(Nz(![Purchasing Authority], 0))
                rstFlags![Data Protection] = Nz(![Data Protection Act], False)
                rstFlags![Data Protection 2] = Nz(![Data Protection Act2], False)
                rstFlags![Source Code] = ![Source Code]
                rstVisitors![Mailing Contact ID] = ![cmbMailingContactID]
                
                rstVisitors![DP_codes] = ![DP_codes]
                rstVisitors![Analysis_Codes] = ![Analysis_Codes]
                rstVisitors![Media_Type] = ![Media_Type]
                rstVisitors![Reg_Method] = ![Reg_Method]
                rstVisitors![A001] = ![A001]
                rstVisitors![A002] = ![A002]
                rstVisitors![A003] = ![A003]
                rstVisitors![A004] = ![A004]
                rstVisitors![A005] = ![A005]
                rstVisitors![A006] = ![A006]
                rstVisitors![A007] = ![A007]
                rstVisitors![A008] = ![A008]
                rstVisitors![A009] = ![A009]
                rstVisitors![A010] = ![A010]
                
                'rstFlags![Seminar Codes] = ![Seminar Codes]
                rstVisitors![Session Codes] = ![Session_Codes]
                rstFlags![ABC Question] = ![ABC Question]
                rstFlags![Payment Amount] = varPaymentAmount
                rstFlags![Payment Method ID] = varPaymentMethodID
                rstFlags![Payment Status ID] = varPaymentStatusID
                rstFlags![Payment Date] = varPaymentDate
                rstFlags![Dietary Requirements] = varDietaryRequirements
                rstFlags![Special Requirements] = varSpecialRequirements
                If intAnswer = vbYes Then
                    rstFlags![Badge Printed] = Now()
                    rstFlags![Badge Print By] = GetCurrentUser()
                End If
                rstVisitors.Update
                'Check Mailing Contact
                If ![cmbMailingContactID] = ![Visitor ID] Then
                    ![cmbMailingContactID].Requery
                End If
                'Check Postal Town
                If boPostalTownLearning Then
                    If ![Address 3].ListIndex = -1 And Not IsNull(![Address 3]) And Not IsNull(![Address 4]) Then
                        CurrentDb.Execute "INSERT INTO dbo_Lup_Tbl_Postal_Towns (Town, Region_Code) " & _
                                          "VALUES (""" & Trim(![Address 3]) & """,""" & ![Address 4].Column(1) & """)", dbFailOnError
                        ![Address 3].Requery
                    End If
                End If
                'Check New Company Name
                If !Company.ListIndex = -1 And Not IsNull(!Company) Then
                    CurrentDb.Execute "INSERT INTO dbo_Tbl_Companies (Show_ID, Company_Name, Company_Name_2) " & _
                                      "VALUES (" & lngShow_ID & ",""" & Trim(!Company) & """,""" & Trim(!Company2) & """)", dbFailOnError
                    !Company.Requery
                End If
                'Save Flags record
                rstFlags.Update
                'Delete demographics and re-create
                CurrentDb.Execute "DELETE FROM dbo_Tbl_Visitors_Demographics" & _
                                  " WHERE Show_ID = " & lngShow_ID & _
                                  "   AND Visitor_ID = " & ![Visitor ID], dbFailOnError
                Set SubForm = !SubDemographics.Form
                For intDemographics = 1 To intDemographicFieldCount
                    boDemographic = False
                    If Not IsNull(SubForm("Multiple " & intDemographics)) Then
                        If SubForm("Multiple " & intDemographics) Then
                            If SubForm("Option Text " & intDemographics).Visible Then
                                boDemographic = True
                                varOptions = SubForm("Option Text " & intDemographics)
                            End If
                        Else
                            If SubForm("Option Combo " & intDemographics).Visible Then
                                boDemographic = True
                                varOptions = SubForm("Option Combo " & intDemographics)
                            End If
                        End If
                        If boDemographic Then
                            If Not IsNull(varOptions) Then
                                Do Until Len(varOptions) = 0
                                    intOption = InStr(varOptions, " ")
                                    If intOption = 0 Then
                                        intOption = Val(varOptions)
                                        varOptions = ""
                                    Else
                                        intOption = Val(Left(varOptions, InStr(varOptions, " ") - 1))
                                        varOptions = Trim(Right(varOptions, Len(varOptions) - InStr(varOptions, " ")))
                                    End If
                                    rstDemographics.AddNew
                                        rstDemographics![Show ID] = lngShow_ID
                                        rstDemographics![Visitor ID] = ![Visitor ID]
                                        rstDemographics![Category] = intDemographics
                                        rstDemographics![Option] = intOption
                                    rstDemographics.Update
                                Loop
                            End If
                        End If
                    End If
                Next intDemographics
                Set SubForm = Nothing
                rstVisitors.Requery
                rstFlags.Requery
                rstDemographics.Requery
                If intAnswer = vbYes Then
                    If Not boOnSite Then
                        If ![Visitor Type] <> igcExhibitor And rstSettings![Visitor Letter] = -1 Then
                            DoCmd.OpenReport "Rpt_" & Show_Name() & " Visitor Letter", acViewNormal, , "[Show ID] = " & lngShow_ID & " And [Visitor ID] = " & ![Visitor ID]
                        ElseIf ![Visitor Type] = igcExhibitor And rstSettings![Exhibitor Letter] = -1 Then
                            DoCmd.OpenReport "Rpt_" & Show_Name() & " Exhibitor Letter", acViewNormal, , "[Show ID] = " & lngShow_ID & " And [Visitor ID] = " & ![Visitor ID]
                        End If
                    End If
                    Go_Print_Badges acViewNormal, "[Show ID] = " & lngShow_ID & " And [Visitor ID] = " & ![Visitor ID], "SINGLE", REGISTRATION_BADGE_SIZE
                End If
                If boOnSite And intAnswer = vbYes Then
                    'Record date and time of attendance
                    strSql = "INSERT INTO dbo_Tbl_Visitor_Entry (Show_ID, Badge_ID, Barcode, Date_And_Time, Visitor_Type) " & _
                             "VALUES (" & lngShow_ID & "," & ![Visitor ID] & ",'" & ![Badge ID] & "', Now()," & ![Visitor Type] & ")"
                    CurrentDb.Execute strSql, dbFailOnError
                End If
                
                ' add the updated record to the OLR queue
                If bln_REGISTRATION_USE_QUEUE = True Then
                    Dim rst_OLR_Queue As Recordset
                    Set rst_OLR_Queue = CurrentDb().OpenRecordset("t_registration_queue", , dbAppendOnly)
                    rst_OLR_Queue.AddNew
                        rst_OLR_Queue!Visitor_ID = ![Visitor ID]
                        rst_OLR_Queue!added_timestamp = Now()
                        rst_OLR_Queue!pending_flag = True
                    rst_OLR_Queue.Update
                End If
                ![AddedMessage] = "Visitor " & ![Visitor ID] & " saved" & IIf(intAnswer = vbYes, " and badge printed.", ".")
                If boPrint Then
                    If ![Visitor Type] = igcExhibitor And Not boOnSite Then
                        boNew_Visitor = True
                        ![Visitor ID] = lngVisitor_ID
                        ![Badge ID] = Null
                        ![Title] = Null
                        ![Forename] = Null
                        ![Surname] = Null
                        ![Job Title] = Null
                        ![E-Mail] = Null
                        ![chkMailingContact] = False
                        ClearDemographics
                        ![Title].SetFocus
                        Get_Next_BadgeID
                        .Repaint
                    Else
                        Clear_Screen
                    End If
                    boSaved_Record = False
                Else
                    boSaved_Record = True
                End If
            End If
        End With
    End If
    DoCmd.Hourglass False
    Exit Sub
Save_Record_Err:
    If Err = Duplicate_Error Then Resume Next
    If Err = ReportCancelled_Error Then
        intAnswer = vbNo
        boPrint = False
        Resume Next
    End If
    Debug.Print strSql
    DoCmd.Hourglass False
    MsgBox Err & " : " & Err.Description, vbCritical, "Error in Sub Save_Record"
End Sub
Private Sub Create_Flag()
    On Error GoTo Flag_ERR
    With rstFlags
        .AddNew
        ![Show ID] = lngShow_ID
        ![Visitor ID] = Forms!Frm_Input![Visitor ID]
        ![Created] = Now()
        ![First Day On Site] = IIf(boOnSite, Date, Null)
        ![Computer Name] = GetMachineName()
        ![Domain Name] = Environ("USERDOMAIN")
        ![Operator Name] = GetCurrentUser()
        ![Batch ID] = 0
    End With
    Exit Sub
Flag_ERR:
    MsgBox Err & " : " & Err.Description, vbCritical, "Error in Sub Create_Flag"
End Sub

[catalepticstate]

strCriteria

Dim strCriteria As String
Private Sub BuildCriteria()
    ' This function activates the print button if there are any badges to be printed.
    On Error GoTo BuildCriteria_Err
    Dim varHolder   As Variant
    Dim varListItem As Variant
    Me.Refresh
    If lstVisitorType.ItemsSelected.count = 0 Then
        strCriteria = "False"
        Exit Sub
    End If
    If Not IsNull(StartNumber) And Not IsNull(EndNumber) Then
        If [StartNumber] > [EndNumber] Then
            'Swap start and end numbers
            varHolder = [StartNumber]
            [StartNumber] = [EndNumber]
            [EndNumber] = varHolder
        End If
    End If
    strCriteria = "[Show ID] = " & lngShow_ID
    If Not IsNull([StartNumber]) Then strCriteria = strCriteria & " AND [Visitor ID] >= " & [StartNumber]
    If Not IsNull([EndNumber]) Then strCriteria = strCriteria & " AND [Visitor ID] <= " & [EndNumber]
    If Not Nz(cmbRegion, "") = "" Then strCriteria = strCriteria & " AND " & cmbRegion
    If Not Nz(cmbEMail, "") = "" Then strCriteria = strCriteria & " AND " & cmbEMail
    If Not Nz(cmbStatus, "") = "" Then strCriteria = strCriteria & " AND [Status ID] = " & cmbStatus
    If Me.chk_Exclude_Printed Then strCriteria = strCriteria & " AND [Badge Printed] IS NULL"
    strCriteria = strCriteria & " AND ("
    For Each varListItem In lstVisitorType.ItemsSelected
        strCriteria = strCriteria & "[Type ID] = " & lstVisitorType.ItemData(varListItem) & " OR "
    Next varListItem
    strCriteria = Left(strCriteria, Len(strCriteria) - 4) & ")"
    Exit Sub
BuildCriteria_Err:
    DoCmd.Hourglass False
    MsgBox Err & " : " & Err.Description, vbCritical, "Error in Function BuildCriteria"
End Sub

[ssanfu]

I can't run your code as my save sub is looking for the badge size which is: str_Size

I get this error: ByRef argument type mismatch

OK, delete "as string" in the procedure header.

Sub Go_Print_Badges(intPrintType As Integer, strCriteria As String, str_Mode As String, str_Size)

The prefix "str_" indicates the parameter is a string.... apparently it is not a string.

[catalepticstate]

I'm sorry I didnt write this software, I have been given the task to fixing it

[ssanfu]

I'm sorry I didnt write this software, I have been given the task to fixing it

Not a problem. I'll look at the additional code you posted under June7's thread...hang in there..

[June7]

This line in sub Save_Record calls the sub Go_Print_Badges:
Go_Print_Badges acViewNormal, "[Show ID] = " & lngShow_ID & " And [Visitor ID] = " & ![Visitor ID], "SINGLE", REGISTRATION_BADGE_SIZE

REGISTRATION_BADGE_SIZE is the value for the strSize argument of Go_Print_Badges? It is not referenced anywhere else in the code. It is not a variable so needs to be within quote marks.