Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Sub routine to create test records.

Access Version or Conversion

Sub routine to create test records.

by  Michael42  Posted    (Edited  )
Sub addTestRecords()
On Error GoTo ErrorHandler

[color green]'Init Vars[/color]
Dim oRS As Recordset
Dim f As Integer, i As Long, k As Long, j As Integer
Dim sTotalRecordsToAdd As String
Dim sFieldName As String

[color green]'Prompt and Get Total to Create[/color]
sTotalRecordsToAdd = InputBox("Enter total records to add (1-nnnnnn).", "Total Records", "1000")
If sTotalRecordsToAdd = "" Then
Exit Sub
End If

[color green]'Add New Records[/color]
Screen.MousePointer = vbHourglass
DoEvents
DoEvents
DoEvents
Set oRS = oDB.OpenRecordset("SELECT * FROM main")
For i = 1 To CLng(sTotalRecordsToAdd) - 1
oRS.AddNew
For f = 0 To oRS.Fields.Count - 1
sFieldName = oRS(f).Name

Select Case oRS(f).Type
Case dbText
oRS(sFieldName) = Trim(Str(i)) & ""
Case dbMemo
oRS(sFieldName) = Trim(Str(i)) & ""
Case dbDate
oRS(sFieldName) = Now
End Select
Next
oRS.Update

[color green]'Help CPU Keep Up (timer loop)[/color]
For j = 1 To 5
DoEvents
Next
Next
oRS.Close

[color green]'Help CPU Keep Up (timer loop)[/color]
For j = 1 To 100
DoEvents
Next
Screen.MousePointer = vbDefault

MsgBox Format(Str(i), "###,###,###,###") & " added.", vbInformation, "Status"

On Error GoTo 0
Exit Sub

ErrorHandler:
Screen.MousePointer = vbDefault
MsgBox "Error: " & Err.Number & vbCrLf & vbCrLf & Err.Description, vbExclamation, "Error (addTestRecords)"

End Sub
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top