1、VB Timer控件代码：

Private Sub Timer1_Timer()

Dim strsql As String
Dim conn As New ADODB.Connection
Dim rst As New ADODB.Recordset

Dim r As Single

Me.Text1 = ""
VBA.Randomize
r = Rnd

conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\" & "ytzc.mdb"
strsql = "select top 1 * from tblbeing where mark='0' order by rnd(" & r & "-id)"
rst.Open strsql,conn,adOpenKeyset,adLockOptimistic

Me.Text1 = rst.Fields(0) & rst.Fields(1)

rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing

End Sub

2、以空格键控制抽奖开始、停止

Private Sub Form_KeyPress(KeyAscii As Integer)
Dim strsql As String
Dim conn As New ADODB.Connection
'Dim rst As New ADODB.Recordse

If mykeycode = "waiting" Then
mykeycode = "start"
ElseIf mykeycode = "start" Then
mykeycode = "stop"
ElseIf mykeycode = "stop" Then
mykeycode = "start"
Else

End If

If KeyAscii = 32 And mykeycode = "start" Then

If mykey = 0 Then
MsgBox "请选择要抽奖的等级",vbOKOnly + 64,"提示"
Else
Me.Timer1.Enabled = True
Me.Timer1.Interval = 10
'Me.Command1.Caption = "停止"
End If

ElseIf KeyAscii = 32 And mykeycode = "stop" Then

Me.Timer1.Enabled = False
'Me.Command1.Caption = "摇奖"

If mykey = 1 Then
Me.Text2 = Me.Text2 & Me.Text1 & vbCrLf
ElseIf mykey = 2 Then
Me.Text3 = Me.Text3 & Me.Text1 & vbCrLf
ElseIf mykey = 3 Then
Me.Text4 = Me.Text4 & Me.Text1 & vbCrLf
Else
End If

conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\" & "ytzc.mdb"
strsql = "update tblbeing set mark=" & "'" & mykey & "'" & "where code=" & "'" & Mid(Me.Text1,5,9) & "'"
'rst.Open strsql,adLockOptimistic 无返回记录集,不能使用recordset
conn.Execute strsql

conn.Close
'Set rst = Nothing
Set conn = Nothing

Else

End If
End Sub

3、或者使用command控件控制抽奖开始、停止

Private Sub Command1_Click()

Dim strsql As String
Dim conn As New ADODB.Connection
'Dim rst As New ADODB.Recordset

If Me.Command1.Caption = "摇奖" Then

If mykey = 0 Then
MsgBox "请选择要抽奖的等级","提示"
Me.Text1 = ""
Else
Me.Timer1.Enabled = True
Me.Timer1.Interval = 10
Me.Command1.Caption = "停止"
End If

ElseIf Me.Command1.Caption = "停止" Then

Me.Timer1.Enabled = False
Me.Command1.Caption = "摇奖"

If mykey = 1 Then
Me.Text2 = Me.Text2 & Me.Text1 & vbCrLf
ElseIf mykey = 2 Then
Me.Text3 = Me.Text3 & Me.Text1 & vbCrLf
ElseIf mykey = 3 Then
Me.Text4 = Me.Text4 & Me.Text1 & vbCrLf
Else
End If

conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\" & "ytzc.mdb"
strsql = "update tblbeing set mark=" & "'" & mykey & "'" & "where code=" & "'" & Mid(Me.Text1,不能使用recordset
conn.Execute strsql

conn.Close
'Set rst = Nothing
Set conn = Nothing

Else

End If

End Sub