Microsoft KB Archive/199679

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

Article ID: 199679

Article Last Modified on 6/24/2004

-

APPLIES TO


 * Microsoft Access 2000 Standard Edition

-



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.



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.



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:  Open the sample database Northwind.mdb.  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:   Run the function in the Immediate window as follows: ?CreateCountTbl("Orders","MyNewTable",5,True)  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:   Run the function in the Immediate window as follows: ?CreateCountTbl("Employees","EveryThirdEmployee",3,False) </li> 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.</li></ol>

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:   Run the function in the Immediate window as follows: ?CreateCountTbl("Customers","NumberedCustomers",1,True) </li> 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.</li></ol>

<div class="references_section">