Batch Insert Problem help

[catalepticstate]

Hi,


I have changed the top line back to: Sub Go_Print_Badges(intPrintType, strCriteria, str_Mode, str_Size)

and the msgbox comes up with the values:

intPrintType = 0
strCriteria = [Show ID] = 1 And [Visitor ID] = 2040
str_Mode = SINGLE
str_Size = 35x4

Once it goes to "Set Records = CurrentDb.OpenRecordset(sSQL, , dbForwardOnly)"

With breakpoints on it says too few parameters

I have attached the table designs

[catalepticstate]

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.

Hi June7
It is referenced somewhere, but this system is such a mess theres so much going on.
The person that has been messing with it has bodged most of it up, but it was very over complicated to do this task.

[June7]

Then I suspect REGISTRATION_BADGE_SIZE is declared as a global variable somewhere. You could do a Find search on the project code.

Changing that line means the variables are not explicitely declared and VBA defaults to Variant datatype. Variants can hold any value and that's why the 'type mismatch' error no longer occurs.

So the code errors on the Set Records line? I believe SELECT SQL statements need a semi-colon, so try:
sSQL = sSQL & " FROM RegPrintQueue;"

[ssanfu]

   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

Uncomment the line in red...what is the SQL?

[catalepticstate]

Then I suspect REGISTRATION_BADGE_SIZE is declared as a global variable somewhere. You could do a Find search on the project code.

Changing that line means the variables are not explicitely declared and VBA defaults to Variant datatype. Variants can hold any value and that's why the 'type mismatch' error no longer occurs.

Hi yes it is Global

And I found a case statement in a form for setting it.

Select Case REGISTRATION_BADGE_SIZE
Case "35x8"
' and the width
imgLowerBadge.Width = imgLowerBadge.Width + Badge_Difference_Width_35x8 * TwipsPerInch
imgUpperBadge.Width = imgUpperBadge.Width + Badge_Difference_Width_35x8 * TwipsPerInch
lbl_Design_Name.Left = lbl_Design_Name.Left + Badge_Difference_Width_35x8 * TwipsPerInch
cmbDesignName.Left = cmbDesignName.Left + Badge_Difference_Width_35x8 * TwipsPerInch
lbl_Copy_Design.Left = lbl_Copy_Design.Left + Badge_Difference_Width_35x8 * TwipsPerInch
cmbCopyDesign.Left = cmbCopyDesign.Left + Badge_Difference_Width_35x8 * TwipsPerInch
lbl_Design_Applies_To.Left = lbl_Design_Applies_To.Left + Badge_Difference_Width_35x8 * TwipsPerInch
lstVisitorTypes.Left = lstVisitorTypes.Left + Badge_Difference_Width_35x8 * TwipsPerInch
BadgeBorder.Width = BadgeBorder.Width + Badge_Difference_Width_35x8 * TwipsPerInch
boxSunken.Width = boxSunken.Width + Badge_Difference_Width_35x8 * TwipsPerInch
Me.InsideWidth = Me.InsideWidth + Badge_Difference_Width_35x8 * TwipsPerInch
' set caption
Me.Caption = Me.Caption & " (Public Badgestock [8x3.5""/206x89mm])"

'Move up any fields which have fallen off the bottom of the badge
CurrentDb.Execute "UPDATE dbo_Tbl_Badge_Fields" & _
" SET [Top] = " & BadgeBorder.Height - 2 * MouseBorder & " - [Height]" & _
" WHERE ([Top] > " & BadgeBorder.Height - 2 * MouseBorder & " - [Height])" & _
" AND Show_ID = " & lngShow_ID
Case "45x5"
'Resize things to use the public badgestock (4.5" x 5")
Me.Detail.Height = Me.Detail.Height - Badge_Difference_Height_45x5 * TwipsPerInch
imgLowerBadge.Top = imgLowerBadge.Top - Badge_Difference_Height_45x5 * TwipsPerInch
lstVisitorTypes.Height = lstVisitorTypes.Height - Badge_Difference_Height_45x5 * TwipsPerInch
SubForm.Top = SubForm.Top - Badge_Difference_Height_45x5 * TwipsPerInch
BadgeBorder.Height = BadgeBorder.Height - Badge_Difference_Height_45x5 * TwipsPerInch
boxSunken.Height = boxSunken.Height - Badge_Difference_Height_45x5 * TwipsPerInch
txtFieldSize.Top = txtFieldSize.Top - Badge_Difference_Height_45x5 * TwipsPerInch
txtFieldName.Top = txtFieldName.Top - Badge_Difference_Height_45x5 * TwipsPerInch
txtTop.Top = txtTop.Top - Badge_Difference_Height_45x5 * TwipsPerInch
txtLeft.Top = txtLeft.Top - Badge_Difference_Height_45x5 * TwipsPerInch
labFieldName.Top = labFieldName.Top - Badge_Difference_Height_45x5 * TwipsPerInch
labFieldSize.Top = labFieldSize.Top - Badge_Difference_Height_45x5 * TwipsPerInch
labX.Top = labX.Top - Badge_Difference_Height_45x5 * TwipsPerInch
labY.Top = labY.Top - Badge_Difference_Height_45x5 * TwipsPerInch
Me.InsideHeight = Me.InsideHeight - Badge_Difference_Height_45x5 * TwipsPerInch
' and the width
imgLowerBadge.Width = imgLowerBadge.Width + Badge_Difference_Width_45x5 * TwipsPerInch
imgUpperBadge.Width = imgUpperBadge.Width + Badge_Difference_Width_45x5 * TwipsPerInch
lbl_Design_Name.Left = lbl_Design_Name.Left + Badge_Difference_Width_45x5 * TwipsPerInch
cmbDesignName.Left = cmbDesignName.Left + Badge_Difference_Width_45x5 * TwipsPerInch
lbl_Copy_Design.Left = lbl_Copy_Design.Left + Badge_Difference_Width_45x5 * TwipsPerInch
cmbCopyDesign.Left = cmbCopyDesign.Left + Badge_Difference_Width_45x5 * TwipsPerInch
lbl_Design_Applies_To.Left = lbl_Design_Applies_To.Left + Badge_Difference_Width_45x5 * TwipsPerInch
lstVisitorTypes.Left = lstVisitorTypes.Left + Badge_Difference_Width_45x5 * TwipsPerInch
BadgeBorder.Width = BadgeBorder.Width + Badge_Difference_Width_45x5 * TwipsPerInch
boxSunken.Width = boxSunken.Width + Badge_Difference_Width_45x5 * TwipsPerInch
Me.InsideWidth = Me.InsideWidth + Badge_Difference_Width_45x5 * TwipsPerInch
' set caption
Me.Caption = Me.Caption & " (Secuirity Badgestock [4.5x5""/126x110mm])"

'Move up any fields which have fallen off the bottom of the badge
CurrentDb.Execute "UPDATE dbo_Tbl_Badge_Fields" & _
" SET [Top] = " & BadgeBorder.Height - 2 * MouseBorder & " - [Height]" & _
" WHERE ([Top] > " & BadgeBorder.Height - 2 * MouseBorder & " - [Height])" & _
" AND Show_ID = " & lngShow_ID
Case "3x6"
'Resize things to use the public badgestock (3" x 6")
imgLowerBadge.Top = imgLowerBadge.Top - Badge_Difference_Height_3x6 * TwipsPerInch
lstVisitorTypes.Height = lstVisitorTypes.Height - Badge_Difference_Height_3x6 * TwipsPerInch
SubForm.Top = SubForm.Top - Badge_Difference_Height_3x6 * TwipsPerInch
BadgeBorder.Height = BadgeBorder.Height - Badge_Difference_Height_3x6 * TwipsPerInch
boxSunken.Height = boxSunken.Height - Badge_Difference_Height_3x6 * TwipsPerInch
txtFieldSize.Top = txtFieldSize.Top - Badge_Difference_Height_3x6 * TwipsPerInch
txtFieldName.Top = txtFieldName.Top - Badge_Difference_Height_3x6 * TwipsPerInch
txtTop.Top = txtTop.Top - Badge_Difference_Height_3x6 * TwipsPerInch
txtLeft.Top = txtLeft.Top - Badge_Difference_Height_3x6 * TwipsPerInch
labFieldName.Top = labFieldName.Top - Badge_Difference_Height_3x6 * TwipsPerInch
labFieldSize.Top = labFieldSize.Top - Badge_Difference_Height_3x6 * TwipsPerInch
labX.Top = labX.Top - Badge_Difference_Height_3x6 * TwipsPerInch
labY.Top = labY.Top - Badge_Difference_Height_3x6 * TwipsPerInch
Me.InsideHeight = Me.InsideHeight - Badge_Difference_Height_3x6 * TwipsPerInch
' and the width
imgLowerBadge.Width = imgLowerBadge.Width + Badge_Difference_Width_3x6 * TwipsPerInch
imgUpperBadge.Width = imgUpperBadge.Width + Badge_Difference_Width_3x6 * TwipsPerInch
lbl_Design_Name.Left = lbl_Design_Name.Left + Badge_Difference_Width_3x6 * TwipsPerInch
cmbDesignName.Left = cmbDesignName.Left + Badge_Difference_Width_3x6 * TwipsPerInch
lbl_Copy_Design.Left = lbl_Copy_Design.Left + Badge_Difference_Width_3x6 * TwipsPerInch
cmbCopyDesign.Left = cmbCopyDesign.Left + Badge_Difference_Width_3x6 * TwipsPerInch
lbl_Design_Applies_To.Left = lbl_Design_Applies_To.Left + Badge_Difference_Width_3x6 * TwipsPerInch
lstVisitorTypes.Left = lstVisitorTypes.Left + Badge_Difference_Width_3x6 * TwipsPerInch
BadgeBorder.Width = BadgeBorder.Width + Badge_Difference_Width_3x6 * TwipsPerInch
boxSunken.Width = boxSunken.Width + Badge_Difference_Width_3x6 * TwipsPerInch
Me.InsideWidth = Me.InsideWidth + Badge_Difference_Width_3x6 * TwipsPerInch
' set caption
Me.Caption = Me.Caption & " (Public Badgestock [6x3""/152x76mm])"

'Move up any fields which have fallen off the bottom of the badge
CurrentDb.Execute "UPDATE dbo_Tbl_Badge_Fields" & _
" SET [Top] = " & BadgeBorder.Height - 2 * MouseBorder & " - [Height]" & _
" WHERE ([Top] > " & BadgeBorder.Height - 2 * MouseBorder & " - [Height])" & _
" AND Show_ID = " & lngShow_ID
Case "3x4"
'Resize things to use the smaller badgestock (3" x 4")
imgLowerBadge.Top = imgLowerBadge.Top - BadgeDifference * TwipsPerInch
lstVisitorTypes.Height = lstVisitorTypes.Height - BadgeDifference * TwipsPerInch
SubForm.Top = SubForm.Top - BadgeDifference * TwipsPerInch
BadgeBorder.Height = BadgeBorder.Height - BadgeDifference * TwipsPerInch
boxSunken.Height = boxSunken.Height - BadgeDifference * TwipsPerInch
txtFieldSize.Top = txtFieldSize.Top - BadgeDifference * TwipsPerInch
txtFieldName.Top = txtFieldName.Top - BadgeDifference * TwipsPerInch
txtTop.Top = txtTop.Top - BadgeDifference * TwipsPerInch
txtLeft.Top = txtLeft.Top - BadgeDifference * TwipsPerInch
labFieldName.Top = labFieldName.Top - BadgeDifference * TwipsPerInch
labFieldSize.Top = labFieldSize.Top - BadgeDifference * TwipsPerInch
labX.Top = labX.Top - BadgeDifference * TwipsPerInch
labY.Top = labY.Top - BadgeDifference * TwipsPerInch
Me.InsideHeight = Me.InsideHeight - BadgeDifference * TwipsPerInch
Me.Caption = Me.Caption & " (Small Badgestock [4x3""/103x76mm])"

'Move up any fields which have fallen off the bottom of the badge
CurrentDb.Execute "UPDATE dbo_Tbl_Badge_Fields" & _
" SET [Top] = " & BadgeBorder.Height - 2 * MouseBorder & " - [Height]" & _
" WHERE ([Top] > " & BadgeBorder.Height - 2 * MouseBorder & " - [Height])" & _
" AND Show_ID = " & lngShow_ID
Case "54x85"
'Resize things to use the public badgestock (54mm x 85mm)
imgLowerBadge.Top = imgLowerBadge.Top + Badge_Difference_Height_54x85 * TwipsPerInch
lstVisitorTypes.Height = lstVisitorTypes.Height + Badge_Difference_Height_54x85 * TwipsPerInch
SubForm.Top = SubForm.Top + Badge_Difference_Height_54x85 * TwipsPerInch
BadgeBorder.Height = BadgeBorder.Height + Badge_Difference_Height_54x85 * TwipsPerInch
boxSunken.Height = boxSunken.Height + Badge_Difference_Height_54x85 * TwipsPerInch
txtFieldSize.Top = txtFieldSize.Top + Badge_Difference_Height_54x85 * TwipsPerInch
txtFieldName.Top = txtFieldName.Top + Badge_Difference_Height_54x85 * TwipsPerInch
txtTop.Top = txtTop.Top + Badge_Difference_Height_54x85 * TwipsPerInch
txtLeft.Top = txtLeft.Top + Badge_Difference_Height_54x85 * TwipsPerInch
labFieldName.Top = labFieldName.Top + Badge_Difference_Height_54x85 * TwipsPerInch
labFieldSize.Top = labFieldSize.Top + Badge_Difference_Height_54x85 * TwipsPerInch
labX.Top = labX.Top + Badge_Difference_Height_54x85 * TwipsPerInch
labY.Top = labY.Top + Badge_Difference_Height_54x85 * TwipsPerInch
Me.InsideHeight = Me.InsideHeight + Badge_Difference_Height_54x85 * TwipsPerInch
' and the width
imgLowerBadge.Width = imgLowerBadge.Width + Badge_Difference_Width_54x85 * TwipsPerInch
imgUpperBadge.Width = imgUpperBadge.Width + Badge_Difference_Width_54x85 * TwipsPerInch
lbl_Design_Name.Left = lbl_Design_Name.Left + Badge_Difference_Width_54x85 * TwipsPerInch
cmbDesignName.Left = cmbDesignName.Left + Badge_Difference_Width_54x85 * TwipsPerInch
lbl_Copy_Design.Left = lbl_Copy_Design.Left + Badge_Difference_Width_54x85 * TwipsPerInch
cmbCopyDesign.Left = cmbCopyDesign.Left + Badge_Difference_Width_54x85 * TwipsPerInch
lbl_Design_Applies_To.Left = lbl_Design_Applies_To.Left + Badge_Difference_Width_54x85 * TwipsPerInch
lstVisitorTypes.Left = lstVisitorTypes.Left + Badge_Difference_Width_54x85 * TwipsPerInch
BadgeBorder.Width = BadgeBorder.Width + Badge_Difference_Width_54x85 * TwipsPerInch
boxSunken.Width = boxSunken.Width + Badge_Difference_Width_54x85 * TwipsPerInch
Me.InsideWidth = Me.InsideWidth + Badge_Difference_Width_54x85 * TwipsPerInch
' set caption
Me.Caption = Me.Caption & " (Credit Card / Plastic Card [85x54mm])"

'Move up any fields which have fallen off the bottom of the badge
CurrentDb.Execute "UPDATE dbo_Tbl_Badge_Fields" & _
" SET [Top] = " & BadgeBorder.Height - 2 * MouseBorder & " - [Height]" & _
" WHERE ([Top] > " & BadgeBorder.Height - 2 * MouseBorder & " - [Height])" & _
" AND Show_ID = " & lngShow_ID
Case "35x4"
Me.Caption = Me.Caption & " (Large Badgestock [103 x 89 mm])"
End Select

Exit Sub
Open_ERR:
MsgBox Err & " : " & Err.Description, vbCritical, "Error Opening Badge Design Form"
Cancel = True
End Sub

[catalepticstate]

   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

Uncomment the line in red...what is the SQL?

This is what I get:

SELECT [Visitor_ID] FROM dbo_Tbl_Visitors LEFT JOIN [Tbl_Workstation Settings] ON dbo_Tbl_Visitors.Show_ID = [Tbl_Workstation Settings].[Show ID] WHERE [Show ID] = 1 And [Visitor ID] = 2040;

[catalepticstate]

The interesting thing is in the Query Tab
I run this code: SELECT [Visitor_ID] FROM dbo_Tbl_Visitors LEFT JOIN [Tbl_Workstation Settings] ON dbo_Tbl_Visitors.Show_ID = [Tbl_Workstation Settings].[Show ID] WHERE [Show ID] = 1 And [Visitor ID] = 2040;

And I get nothing out putted.

But when I run

SELECT [Visitor_ID] FROM dbo_Tbl_Visitors LEFT JOIN [Tbl_Workstation Settings] ON dbo_Tbl_Visitors.Show_ID = [Tbl_Workstation Settings].[Show ID] WHERE [Show ID] = 1 And [Visitor_ID] = 2040;

Notice the underscore in Visitor_ID

It outputs 2040

Thats where its missing the parameter, maybe?

[ssanfu]

Thats where its missing the parameter, maybe?

Yes, that would be the problem That is just one of the reasons I don't use spaces in object names. That way I use the same format in naming objects.

Here is another revision. The changes are in blue

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
   Dim sSQL As String
   Dim pCriteria As String

   pCriteria = Replace(strCriteria, "Visitor ID", "Visitor_ID")

   '-----------------------------
   ' 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 " & pCriteria & ";"

I just noticed you are using A97. It might not have the Replace function... Let me know

[catalepticstate]

Hi,
You were right, it did not like Replace.

[ssanfu]

Here is a replace function for Access 97 from Allen Browne ( Microsoft MVP. Perth, Western Australia).

Paste it in a standard module. Name the module "UtilityCode".... or something like that.

Function Replace(strExpr As String, strFind As String, strReplace As String, Optional lngStart As Long = 1) As String
   'A Replace function for Access 97
   Dim strOut As String
   Dim lngLenExpr As Long
   Dim lngLenFind As Long
   Dim lng As Long

   lngLenExpr = Len(strExpr)
   lngLenFind = Len(strFind)

   If (lngLenExpr > 0) And (lngLenFind > 0) And (lngLenExpr >= lngStart) Then
      lng = lngStart
      If lng > 1 Then
         strOut = Left$(strExpr, lng - 1)
      End If
      Do While lng <= lngLenExpr
         If Mid(strExpr, lng, lngLenFind) = strFind Then
            strOut = strOut & strReplace
            lng = lng + lngLenFind
         Else
            strOut = strOut & Mid(strExpr, lng, 1)
            lng = lng + 1
         End If
      Loop
      Replace = strOut
   End If
End Function

[catalepticstate]

Hi

I fixed the issue with the sql statement, I used another variable that is in the system and works fine.

But only problem is it only adds one record.

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
   Dim sSQL As String
   Dim strDirectory 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
    DoCmd.Echo True, "Sending to Spooler..."
      sSQL = "SELECT [Visitor_ID], [Directory]"
      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 Visitor_ID = " & Forms![Frm_Input]![Visitor ID] & ";"
      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")
            strDirectory = Records.Fields("Directory")
 
            rstSpool.AddNew
            rstSpool!JobNo = nJobNo
            rstSpool!SequenceNo = nSequenceNo
            rstSpool!Database = strDirectory    'MDB Directory
            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
            '---------------------------------------------
    DoCmd.Echo True, "Printing Badge..."
            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
End Sub

This could be because there are no duplicates allowed in JobNo and SequenceNo in the RegPrintQueue table

So I guess my loop is not working properly. If you have a look at my first post it is meant to enter the JobNo and SequenceNo like how its outlined.

Thanks for all your help

[ssanfu]

I fixed the issue with the sql statement, I used another variable that is in the system and works fine.

But only problem is it only adds one record.


This could be because there are no duplicates allowed in JobNo and SequenceNo in the RegPrintQueue table

So I guess my loop is not working properly. If you have a look at my first post it is meant to enter the JobNo and SequenceNo like how its outlined.

Thanks for all your help

Glad you got it working...

How many records are being selected in the "Records" recordset? (there was a msgbox in the code) Since it is selecting visitor ID, I would think there would only be one record selected.

[catalepticstate]

Glad you got it working...

How many records are being selected in the "Records" recordset? (there was a msgbox in the code) Since it is selecting visitor ID, I would think there would only be one record selected.

Only one record is being selected, but if I select another record it does not get added to the RegPrintQueue table.

The idea is:

Search for visitor -> Open his details -> Send to Print and Save Record

The last part "send to print" also has the option to insert into RegPrintQueue as we have another piece of software that looks for Spooler.mdb which has RegPrintQueue a table if the option to use Spooler has been defined.

We need the JobNo to be recorded as 1,2,3,4,5,6 etc and SequenceNo to be recorded 1,2,3,4,5,6 etc

This is what I was given to work with:

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.

In the PrintBadges routine
Open forward only recordset with strCriteria
Open a dynamic recordset on the Spooler.mdb table and start addings records
When all records are added, perform a commit
Whilst adding records, set the job number correctly and the sequence number ascending

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

[catalepticstate]

Hi all,
Thank you for all your help.

Here is the final solution:

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
   Dim sSQL As String
   Dim strDirectory 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
    'Mid(strCriteria, 20) = "Visitor_ID"
    DoCmd.Echo True, "Sending to Spooler..."
      sSQL = "SELECT dbo_Tbl_Visitors.[Visitor_ID] AS [Visitor ID], dbo_Tbl_Visitors.[Show ID], [Tbl_Visitors Flags].[Type ID], [Tbl_Visitors Flags].[Status ID]" & _
        " FROM dbo_Tbl_Visitors INNER JOIN [Tbl_Visitors Flags]" & _
        " ON dbo_Tbl_Visitors.[Visitor_ID] = [Tbl_Visitors Flags].[Visitor ID]" & _
        " WHERE " & strCriteria & ";"
      'sSQL = "SELECT [Visitor ID], [Directory], [Type ID]" & _
      'sSQL = sSQL & " FROM (Tbl_Visitors INNER JOIN [Tbl_Workstation Settings]"
      'sSQL = sSQL & " ON Tbl_Visitors.[Show ID] = [Tbl_Workstation Settings].[Show ID]) INNER JOIN [Tbl_Visitors Flags] ON Tbl_Visitors.[Visitor ID] = [Tbl_Visitors Flags].[Visitor 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"
         '---------------
         sSQL = "SELECT Max(JobNo) As MaxJobNo FROM RegPrintQueue" 'Yaroslav's check for current JobNo
         Set rstSpool = CurrentDb.OpenRecordset(sSQL, , dbForwardOnly)
         rstSpool.MoveFirst
         If nJobNo = Null Then
            nJobNo = 1
         Else
            nJobNo = rstSpool!MaxJobNo + 1 'Increment to next available JobNo
         End If
         rstSpool.Close
         
         'sSQL = "SELECT Max(SequenceNo) As MaxSequenceNo FROM RegPrintQueue" 'Yaroslav's check for current SequenceNo
         'Set rstSpool = CurrentDb.OpenRecordset(sSQL, , dbForwardOnly)
         'rstSpool.MoveFirst
         'nSequenceNo = rstSpool!MaxSequenceNo + 1 'Increment to next available JobNo
         'rstSpool.Close
         
          ' 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]")
            strDirectory = strSystem_Directory 'Records.Fields("Directory")
 
            rstSpool.AddNew
            rstSpool!JobNo = nJobNo
            rstSpool!SequenceNo = nSequenceNo
            rstSpool!Database = strDirectory    'MDB Directory
            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
            '---------------------------------------------
    DoCmd.Echo True, "Printing Badge..."
            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
End Sub

It works as desired, but now I have come up with another problem to do with the same function

I am trying to save and print my record. Once it saves, it goes to the function above.

Here is the save function:

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
                'Photo Save
                Dim str_badge_id As String
                str_badge_id = ![Badge ID]
                !ctl_Image.SaveToFile strSystem_Directory & "\photos\" & str_badge_id & ".jpg"
                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

This function causes a parameter expected error which requires 1

                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

Using the breakpoints I have found it happens at this point:

Go_Print_Badges acViewNormal, "[Show ID] = " & lngShow_ID & " And [Visitor ID] = " & ![Visitor ID], "SINGLE", REGISTRATION_BADGE_SIZE

Can anyone help?