Notice: This website is an unofficial Microsoft Knowledge Base (hereinafter KB) archive and is intended to provide a reliable access to deleted content from Microsoft KB. All KB articles are owned by Microsoft Corporation. Read full disclaimer for more details.

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


View products that this article applies to.

This article was previously published under Q199679
This article applies only to a Microsoft Access database (.mdb).

Advanced: Requires expert coding, interoperability, and multiuser skills.

↑ Back to the top


Summary

This article contains sample Visual Basic for Applications code that you can use to select an incremented number of records from an existing table or query and to create a dynamic counter value for those records in a new table. You can use this sample code for the following purposes:
  • To create a new table with an AutoNumber field to act as a record counter for a pre-existing set of records.
  • To return every Nth record from a table or query and to store the results in a new table with an AutoNumber field, which simulates a record counter.
  • To return every Nth record from a table or query and to store the results in a new table.

↑ Back to the top


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.

↑ Back to the top


References

For additional information about how to test if a table or query already exists within a database, click the article number below to view the article in the Microsoft Knowledge Base:
210398� ACC2000: Sample Code to Check for Table or Query in a Database

↑ Back to the top


Keywords: KB199679, kbusage, kbdtacode, kbhowto

↑ Back to the top

Article Info
Article ID : 199679
Revision : 2
Created on : 6/24/2004
Published on : 6/24/2004
Exists online : False
Views : 371