Article ID: 108435
Article Last Modified on 1/18/2007
Option Explicit
Function FindRandom (RecordSetName As String, Fieldname As String)
Dim MyDB As Database
Dim MyRS As Recordset
Dim SpecificRecord As Long, i As Long, NumOfRecords As Long
Set MyDB = CurrentDB()
'change DB_Open_Dynaset to DBOpenDynaset for Access 97
Set MyRS = MyDB.OpenRecordset(RecordSetName, DB_Open_Dynaset)
On Error GoTo NoRecords
MyRS.MoveLast
NumOfRecords = MyRS.RecordCount
SpecificRecord = Int(NumOfRecords * Rnd)
If SpecificRecord = NumOfRecords Then
SpecificRecord = SpecificRecord - 1
End If
MyRS.MoveFirst
For i = 1 To SpecificRecord
MyRS.MoveNext
Next i
FindRandom = MyRS(Fieldname)
Exit Function
NoRecords:
If Err = 3021 Then
MsgBox "There Are No Records In The Dynaset", 16, "Error"
Else
MsgBox "Error - " & Err & Chr$(13) & Chr$(10) & Error, _
16, "Error"
End If
FindRandom = "No Records"
Exit Function
End Function
In Microsoft Access 1.x:
Function FindRandom (RecordSetName As String, Fieldname As String)
Dim MyDB As Database
Dim MyRS As DynaSet
Dim SpecificRecord As Long, i As Long, NumOfRecords As Long
Set MyDB = CurrentDB()
Set MyRs = MyDB.CreateDynaset(RecordSetName)
On Error GoTo NoRecords
MyRS.MoveLast
NumOfRecords = MyRS.RecordCount
SpecificRecord = Int(NumOfRecords * Rnd)
If SpecificRecord = NumOfRecords Then
SpecificRecord = SpecificRecord - 1
End If
MyRS.MoveFirst
For i = 1 To SpecificRecord
MyRS.MoveNext
Next i
FindRandom = MyRS(Fieldname)
Exit Function
NoRecords:
If Err = 3021 Then
MsgBox "There Are No Records In The Dynaset", 16, "Error"
Else
MsgBox "Error - " & Err & Chr$(13) & Chr$(10) & Error, _
16, "Error"
End If
FindRandom = "No Records"
Exit Function
End Function
?FindRandom("<RecordSetName>", "<FieldName>")
128874 ACC: Find N Records in Random Order
Keywords: kbinfo kbprogramming KB108435