Sub Select_Student()
Dim rnum(1 To 5) As Integer
Dim counter As Integer
Dim rec As Recordset
Dim recNew As Recordset
Set rec = New ADODB.Recordset
Set recNew = New ADODB.Recordset
'Delete any existing tblSelected and create a blank new one
Call DeleteTable
Call CreateTable
Call GenRandom(rnum, 5)
rec.ActiveConnection = CurrentProject.Connection
rec.CursorType = adOpenStatic
rec.Open "student"
recNew.ActiveConnection = CurrentProject.Connection
recNew.LockType = adLockOptimistic
recNew.Open "tblSelected"
For counter = 1 To 5
rec.MoveFirst
rec.Move (rnum(counter))
recNew.AddNew
recNew("student#") = rec("student#")
recNew.Update
Next
rec.Close
recNew.Close
Set rec = Nothing
Set recNew = Nothing
End Sub
Function CntRec() As Long
Dim rec As ADODB.Recordset
Set rec = New ADODB.Recordset
'Open the recordset
'Count the number of records
rec.CursorType = adOpenStatic
rec.Open "student", CurrentProject.Connection
CntRec = rec.RecordCount
rec.Close
Set rec = Nothing
End Function
Sub GenRandom(numList As Variant, size As Integer)
Dim numrec As Long
Dim i As Integer
Dim j As Integer
Dim tnum As Integer
Dim newnum As Boolean
numrec = CntRec()
For i = 1 To size
newnum = False
Do Until newnum = True
tnum = Int(numrec * Rnd)
If tnum = 0 then
tnum = 1
End If
For j = 1 To i
If tnum = numList(j) Then
newnum = False
Exit For
Else
newnum = True
End If
Next
numList(i) = tnum
Next
End Sub
Sub CreateTable()
'Add the
Dim tdf As ADOX.Table
Dim idx As ADOX.Index
'Declare and instantiate a Catalog object
Dim cat As ADOX.Catalog
Set cat = New ADOX.Catalog
'Establish a connection
cat.ActiveConnection = CurrentProject.Connection
' Instantiate a Table object
Set tdf = New ADOX.Table
' Name the table and add field to it
With tdf
.Name = "tblSelected"
Set .ParentCatalog = cat
.Columns.Append "Student#", adWChar, 10
End With
'Append the table to the Tables collection
cat.Tables.Append tdf
'Instantiate an Index object
Set idx = New ADOX.Index
'Set properties of the index
With idx
.Name = "PrimaryKey"
.Columns.Append "Student#"
.PrimaryKey = True
.Unique = True
End With
'Add the index to the Indexes collection
'of the table
tdf.Indexes.Append idx
Set idx = Nothing
Set cat = Nothing
End Sub
Sub DeleteTable()
'Ignore error if it occurs
On Error Resume Next
'Declare and instantiate a Catalog object
Dim cat As ADOX.Catalog
Set cat = New ADOX.Catalog
'Establish the connection for the Catalog object
cat.ActiveConnection = CurrentProject.Connection
'Delete a table from the tables collection
cat.Tables.Delete "tblSelected"
End Sub