ACC2000: How to Simulate a Dynamic Counter in a Table or a Query to Count Records

MORE INFORMATION

The following two user-defined Visual Basic for Application functions, CreateCountTbl() and IsTableQuery(), select an incremented number of records from either a table or a query and assign an AutoNumber to the records within a newly created table.

NOTE: The sample code in this article uses Microsoft Data Access Objects. For this code to run properly, you must reference the Microsoft DAO 3.6 Object Library. To do so, click References on the Tools menu in the Visual Basic Editor, and make sure that the Microsoft DAO 3.6 Object Library check box is selected.

NOTE: The CreateCountTbl() function can use any type of table or query.

To use these functions, follow these steps:

1. Open the sample database Northwind.mdb.
2. Type or paste the following functions into a new module:

   Option Explicit
   Option Compare Database
   
   Function CreateCountTbl(CCT_SourceTblName As String, _
       CCT_NewTblname As String, CCT_NumRecs As Long, _
       CCT_AddAutoNum As Boolean) As Boolean
       '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       'FUNCTION:
       '   CreateCountTbl()
       '
       'PURPOSE:
       '   Create a new table from an already existing table or query.
       '
       'ARGUMENTS:
       '   CCT_SourceTblName: The name of the source table or query.
       '         CCT_NumRecs: The number of record increments you want to use.
       '                      If 0, then just the structure is copied.
       '                      If 1, then all records are copied.
       '                      If > 1, then only the increment of records that
       '                      you want to copy are used.
       '      CCT_NewTblname: the name of the destination table
       '          AddAuonum : Adds a AutoNumber field to the new table if true
       '
       'RETURNS:
       '   True (it successful) or False (if not).
       '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       On Error GoTo Err_CreateCountTbl
   
       Dim myDb As DAO.Database
       Dim MyRs As DAO.Recordset
       Dim NewRs As DAO.Recordset
       Dim NewTd As DAO.TableDef
       Dim myfld As DAO.Field
       Dim x As Integer
   
       'Check to see if the source table exists.
       'If it does, continue; if not, exit.
       If IsTableQuery("", CCT_SourceTblName) Then
           Set myDb = CurrentDb()
           Set MyRs = myDb.OpenRecordset(CCT_SourceTblName, dbOpenSnapshot)
           'Check to see if the destination table exists.
           If IsTableQuery("", CCT_NewTblname) Then
               'If it does exist, then prompt to delete table.
               If MsgBox("Do you want to delete the table or query " & _
                   CCT_NewTblname, vbYesNo, "Object Found") = vbYes Then
                   On Error Resume Next
                   DoCmd.DeleteObject acTable, CCT_NewTblname
                   
                   If Err <> 0 Then
                       On Error GoTo Err_deleteQ
                       DoCmd.DeleteObject acQuery, CCT_NewTblname
                   End If
               Else
                   MsgBox "Please use a different new table name", vbOKOnly
                   CreateCountTbl = False
                   MyRs.Close
                   myDb.Close
                   GoTo End_createCountTbl
               End If
           End If
           
           On Error GoTo Err_CreateCountTbl
           
           'Create the new table.
           Set NewTd = myDb.CreateTableDef(CCT_NewTblname)
           
           'Append the fields using the field names and
           'types from the already existing data.
           If CCT_AddAutoNum Then
               Set myfld = NewTd.CreateField(CCT_NewTblname & _
                   "AutoID", dbLong)
               myfld.Attributes = myfld.Attributes + dbAutoIncrField
               NewTd.Fields.Append myfld
           End If
           
           For Each myfld In MyRs.Fields
               With NewTd
                   .Fields.Append .CreateField(myfld.Name, _
                       myfld.Type, myfld.Size)
               End With
           Next myfld
           
           myDb.TableDefs.Append NewTd
           Set NewRs = myDb.OpenRecordset(CCT_NewTblname, , dbAppendOnly)
   
           'Loop through recordset, appending data in the new recordset.
           MyRs.MoveFirst
           x = 1
   
           Do While Not MyRs.EOF
               If x = CCT_NumRecs Then
                   NewRs.AddNew
                   
                   For Each myfld In MyRs.Fields
                       NewRs(myfld.Name) = MyRs(myfld.Name)
                   Next myfld
                   
                   NewRs.Update
                   x = 0
               End If
   
               x = x + 1
               MyRs.MoveNext
           Loop
   
           NewRs.Close
           MyRs.Close
           myDb.Close
           CreateCountTbl = True
       Else
           MsgBox "Then Table " & CCT_SourceTblName & " does not exist", _
               vbOKOnly, "Can't find table"
           CreateCountTbl = False
       End If
   
   End_createCountTbl:
       Exit Function
   
   Err_deleteQ:
       MsgBox "There was a problem deleting the Table or query " & _
           CCT_NewTblname, vbOKOnly
       CreateCountTbl = False
       Exit Function
   
   Err_CreateCountTbl:
       MsgBox Err & " " & Error$, vbOKOnly
       CreateCountTbl = False
   End Function
   
   Function IsTableQuery(DbName As String, TName As String) As Integer
       '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       'FUNCTION:
       '   IsTableQuery()
       '
       'PURPOSE:
       '   Determine if a table or query exists.
       '
       'ARGUMENTS:
       '   DbName: The name of the database.
       '           If the database name is "", the current database is used.
       '    TName: The name of a table or query.
       '
       'RETURNS:
       '   True (it exists) or False (it does not exist).
       '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       Dim Db As DAO.Database
       Dim Found As Integer
       Dim Test As String
   
       Const NAME_NOT_IN_COLLECTION = 3265
   
       'Assume the table or query does not exist.
       Found = False
   
       'Trap for any errors.
       On Error Resume Next
   
       'If the database name is empty...
       If Trim$(DbName) = "" Then
           '...then set Db to the current Db.
           Set Db = CurrentDb()
       Else
           'Otherwise, set Db to the specified open database.
           Set Db = DBEngine.Workspaces(0).OpenDatabase(DbName)
           
           'See if an error occurred.
           If Err Then
               MsgBox "Could not find database to open: " & DbName
               IsTableQuery = False
               Exit Function
           End If
       End If
   
       'See if the name is in the Tables collection.
       Test = Db.TableDefs(TName).Name
   
       If Err <> NAME_NOT_IN_COLLECTION Then Found = True
   
       'Reset the error variable.
       Err = 0
   
       'See if the name is in the Queries collection.
       Test = Db.QueryDefs(TName$).Name
   
       If Err <> NAME_NOT_IN_COLLECTION Then Found = True
   
       Db.Close
   
       IsTableQuery = Found
   End Function
   					

How to Return Every Nth Record with an AutoNumber Value from a Table or a Query

To view every fifth order from the Orders table and to have the results sequentially numbered, follow these steps:

1. Run the function in the Immediate window as follows:

   ?CreateCountTbl("Orders","MyNewTable",5,True)
   					

2. Open the newly created table, MyNewTable. Note that every fifth record from the Orders table has been included in this new table, and that the records are numbered sequentially.

How to Return Every Nth Record from a Table or a Query

To view every third employee from the Employees table, follow these steps:

1. Run the function in the Immediate window as follows:

   ?CreateCountTbl("Employees","EveryThirdEmployee",3,False)
   					

2. Open the newly created table, EveryThirdEmployee. Note that every third record from the Employees table has been included in this new table, with no sequential number.

How to Return Every Record with an AutoNumber Value from a Table or a Query

To sequentially number every customer in the Customers table, follow these steps:

1. Run the function in the Immediate window as follows:

   ?CreateCountTbl("Customers","NumberedCustomers",1,True)
   					

2. Open the newly created table, NumberedCustomers. Note that every record in the Customers table is included in this new table, and that every record is numbered sequentially.