Share Recordset between Subs

just1joe

Board Regular
Joined
Apr 15, 2003
Messages
79
Hello,

I am trying to loop through a table, "Contacts", and for each record output file(s) if it meets certain criteria. I split it into multiple Subs because it would not compile, but I do not know how to share the same recordset between the multiple Subs.

This is probably a very newbie issue, but I cannot seem to search for the correct thing to find a solution.

Thank you for any help.

- Joe

Code Snip ---------------------------------
Public Sub PrintAll()
' Loop Through all Records and Print badges

Dim db As DAO.Database
Dim myrs As DAO.Recordset
Set db = CurrentDb()
Set myrs = db.OpenRecordset("Contacts")

If myrs.BOF And myrs.EOF Then 'IT MEANS THERE ARE NO RECORDS, WE ARE AT THE BEGINNING OF FILE AND END OF FILE
Else '
Do Until myrs.EOF 'DO UNTIL END OF RECORDSET

Call PrintAll_Badges

myrs.MoveNext
Loop

End If

myrs.Close 'Close recordset

Exit_PrintAll:
Set myrs = Nothing 'Deassign all objects.
Set db = Nothing
Exit Sub

End Sub

Public Sub BadgePrint()
' File Header

Print #1, Chr(34) & "Attendee ID" & Chr(34) & "," & Chr(34) & "First Name" & Chr(34) & "," & Chr(34) & "Last Name" & Chr(34) & "," & Chr(34) & "Company" & Chr(34) & "," & Chr(34) & "Job Title" & Chr(34) & "," & _
Chr(34) & "Attendee Type" & Chr(34) & "," & Chr(34) & "E-mail Address" & Chr(34) & "," & Chr(34) & "Business Phone" & Chr(34) & "," & Chr(34) & "Mobile Phone" & Chr(34) & "," & Chr(34) & "Fax Number" & Chr(34) & _
"," & Chr(34) & "Address 1" & Chr(34) & "," & Chr(34) & "Address 2" & Chr(34) & "," & Chr(34) & "City" & Chr(34) & "," & Chr(34) & "State/Province" & Chr(34) & "," & Chr(34) & "ZIP/Postal Code" & Chr(34) & "," & Chr(34) & _
"Country/Region" & Chr(34) & "," & Chr(34) & "Session List" & Chr(34) & "," & Chr(34) & "OS10SW1" & Chr(34) & "," & Chr(34) & "OS10SW2" & Chr(34) & "," & Chr(34) & "OS10SW3" & Chr(34) & "," & Chr(34) & "OS10SW4" & Chr(34) & "," & Chr(34) & "OS10SW5" & Chr(34) & "," & Chr(34) & _
"OS10SW6" & Chr(34) & "," & Chr(34) & "OS10SW7" & Chr(34) & "," & Chr(34) & "OS10SW8" & Chr(34) & "," & Chr(34) & "OS10SW9" & Chr(34) & "," & Chr(34) & "OS10SW10" & Chr(34) & "," & Chr(34) & "OS10SW11" & Chr(34) & "," & Chr(34) & "OS10SW12" & Chr(34) & "," & Chr(34) & "OS10SWVIRT" & Chr(34) & "," & Chr(34) & "OS10SWCISCO" & Chr(34) & "," & Chr(34) & _
"Print Code" & Chr(34) & Chr(13); Chr(34) & myrs![Attendee ID] & Chr(34) & "," & Chr(34) & myrs![First Name] & Chr(34) & "," & Chr(34) & myrs![Last Name] & Chr(34) & "," & Chr(34) & myrs![Company] & Chr(34) & "," & Chr(34) & myrs![Job Title] & Chr(34) & "," & Chr(34) & _
myrs![Attendee Type] & Chr(34) & "," & Chr(34) & myrs![E-mail Address] & Chr(34) & "," & Chr(34) & myrs![Business Phone] & Chr(34) & "," & Chr(34) & myrs![Mobile Phone] & Chr(34) & "," & Chr(34) & myrs![Fax Number] & Chr(34) & _
"," & Chr(34) & myrs![Address 1] & Chr(34) & "," & Chr(34) & myrs![Address 2] & Chr(34) & "," & Chr(34) & myrs![City] & Chr(34) & "," & Chr(34) & myrs![State/Province] & Chr(34) & "," & Chr(34) & myrs![ZIP/Postal Code] & Chr(34) & "," & Chr(34) & _
[Country/Region] & Chr(34) & "," & Chr(34) & myrs![Session List] & Chr(34) & "," & Chr(34) & myrs![OS10SW1] & Chr(34) & "," & Chr(34) & myrs![OS10SW2] & Chr(34) & "," & Chr(34) & myrs![OS10SW3] & Chr(34) & "," & Chr(34) & myrs![OS10SW4] & Chr(34) & "," & Chr(34) & myrs![OS10SW5] & Chr(34) & "," & Chr(34) & _
[OS10SW6] & Chr(34) & "," & Chr(34) & myrs![OS10SW7] & Chr(34) & "," & Chr(34) & myrs![OS10SW8] & Chr(34) & "," & Chr(34) & myrs![OS10SW9] & Chr(34) & "," & Chr(34) & myrs![OS10SW10] & Chr(34) & "," & Chr(34) & myrs![OS10SW11] & Chr(34) & "," & Chr(34) & myrs![OS10SW12] & Chr(34) & "," & Chr(34) & myrs![OS10SWVIRT] & Chr(34) & "," & Chr(34) & myrs![OS10SWCISCO] & Chr(34) & "," & Chr(34) & myrs![Print Code] & Chr(34) & Chr(13)

End Sub

Public Sub PrintAll_Badges()

Dim strDate As String
Dim strTime As String
Dim strFilename As String
strDate = Format((Date), "yyyymmdd")
strTime = Format((Time), " hhmmss")
strFilename = "C:\InfoSecPrint\b" & strDate & strTime & "00.dd"
Open strFilename For Output As #1 'Open file for output.
Call BadgePrint
Close #1

Call sleeper

' Check for Tickets

If myrs![OS10SW1] = True Then
strFilename = "C:\InfoSecPrint\b" & strDate & strTime & "01.sw1"
Open strFilename For Output As #1 'Open file for output.
Call BadgePrint
Close #1
End If

Call sleeper

If myrs![OS10SW2] = True Then
strFilename = "C:\InfoSecPrint\b" & strDate & strTime & "02.sw2"
Open strFilename For Output As #1 'Open file for output.
Call BadgePrint
Close #1
End If

snip
Do this for 18 other instances.
snip

End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Joe

Why did you split it out into multiple subs?

What is the purpose of this code?

Have you considered using Word mail merge with the Access table/query as the data source?
 
Upvote 0
Was the error you got something about too many concatenations in the sub/module? I agree with Norie that this looks like it could be done more elegantly another way.

If you must reference a recordset in another function/sub just pass it as a parameter
...
Call PrintAll_Badges(myrs)
...

Then make sure to include the parameter in PrintAll_Badges

Public Sub PrintAll_Badges(rst as dao.recordset)
 
Upvote 0
Norie,

The goal for this is to output files that are processed by another system to generate badges and tickets. I have it setup to print one at a time but I need to also print batch. The output is on continuous feed stock so they have to print out in a certain order and all of the items for the same person print together.

When I had it all in one sub, I received an error saying it was to big to compile and suggested I break it into multiple subs.

- Joseph

ps. sorry about not using the code tags.
 
Upvote 0
Yes. In answer to the first post, you can pass recordset references through the call.
You'd do something like:

Call PrintAll_Badges(myrs)

And then change the sub signature line to:

Public Sub PrintAll_Badges(rs As DAO.Recordset)
(this is what Revans said previously)

A slicker alternative would be to declare the recordset object up in the global variables. At the top of your code module above all functions/subroutines you'd add in your recordset declaration which makes it a module level variable. A global variable would look like:

Global objWkb As Object 'Workbook

Here's a technique suggestion. Instead of concatenating all the text at the point where you're inserting it into the text output file, how about concatenating it into a string variable and than passing the string to the Print?

For example:

Code:
strVal = Chr(34) & "Attendee ID" & Chr(34) & "," & Chr(34) & "First Name" & Chr(34) & "," & Chr(34) & "Last Name" & Chr(34) & "," & Chr(34) & "Company" & Chr(34) & "," & Chr(34) & "Job Title" & Chr(34) & "," & _
Chr(34) & "Attendee Type" & Chr(34) & "," & Chr(34) & "E-mail Address" & Chr(34) & "," & Chr(34) & "Business Phone" & Chr(34) & "," & Chr(34) & "Mobile Phone" & Chr(34) & "," & Chr(34) & "Fax Number" & Chr(34)

strVal = strVal & "," & Chr(34) & "Address 1" & Chr(34) & "," & Chr(34) & "Address 2" & Chr(34) & "," & Chr(34) & "City" & Chr(34) & "," & Chr(34) & "State/Province" & Chr(34) & "," & Chr(34) & "ZIP/Postal Code" & Chr(34) & "," & Chr(34) &

strVal = strVal & "Country/Region" & Chr(34) & "," & Chr(34) & "Session List" & Chr(34) & "," & Chr(34) & "OS10SW1" & Chr(34) & "," & Chr(34) & "OS10SW2" & Chr(34) & "," & Chr(34) & "OS10SW3" & Chr(34) & "," & Chr(34) & "OS10SW4" & Chr(34) & "," & Chr(34) & "OS10SW5" & Chr(34) & "," & Chr(34)

An even better technique would be to walk through the recordset object and read the fields into the results. This is a bit more than you likely need, however, it's a function that returns a list of all the fieldnames in a given table by incrementing through the list of fields themselves rather than needing to know anything at all about how it's laid out. I used a function such as "GetDistinct" for action queries, for example.

Code:
Function GetDistinct(ByRef dbs As DAO.Database, _
                     ByVal strSource As String, _
                     ByVal tblName As String)
Dim strSQL As String

strSQL = "SELECT DISTINCT " & GetFlds(strSource) & " INTO " & tblName & " FROM " & strSource
DoCmd.RunSQL strSQL

End Function

Public Function GetFlds(ByVal MyTable As String, _
                        Optional ByVal myType As String, _
                        Optional HowMany As Integer) As String
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim x, intFields As Integer

On Error GoTo HandleErr
Set dbs = CurrentDb()

' This was a test looking for how the table name was passed in.  If it came within brackets
' then I needed to handle that

If InStr(MyTable, "[") = 0 Then
   strSQL = "SELECT * FROM [" & MyTable & "]"
Else
   strSQL = "SELECT * FROM " & MyTable
End If

Set rs = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

With rs
  ' If I'm inserting an additional field at a given position
  ' then add one to the number of fields now
  intFields = .Fields.Count - 1
  For x = 0 To intFields
    ' This was intended to allow me to specific a maximum number of fields to pull
    ' It's really something I used application specific and probably should be yanked by you
    If HowMany > 0 And x > HowMany Then Exit For   ' Sets limit on how many fields actually used
    If x = myType Then
       GetFlds = GetFlds & "' ', "
    End If
        GetFlds = GetFlds & "[" & .Fields(x).Name & "], "
  Next x
  If HowMany > intFields + 1 Then  ' if need more blank fields, add
    For x = x To HowMany
       GetFlds = GetFlds & "' ', "
    Next x
  End If
End With

GetFlds = Trim(Left(GetFlds, Len(GetFlds) - 2))

ExitHere:
Set rs = Nothing
Set dbs = Nothing
    Exit Function

' Error handling block added by Error Handler Add-In. DO NOT EDIT this block of code.
' Automatic error handler last updated at 09-16-2005 15:38:02   'ErrorHandler:$$D=09-16-2005    'ErrorHandler:$$T=15:38:02
HandleErr:
    Select Case Err.Number
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "modUtil.GetFlds"    'ErrorHandler:$$N=modUtil.GetFlds
    End Select
    GoTo ExitHere
' End Error handling block.
End Function

A modification you're probably interested in would be to insert the Chr(34) at appropriate points to your needs inside the string building process. You'd just want to adapt this to your needs, not use it all as-is.

Mike
 
Upvote 0

Forum statistics

Threads
1,214,649
Messages
6,120,732
Members
448,987
Latest member
marion_davis

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top