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