Excessive Lag with VBA APP

Hi all;

I am a developer for an organization, tasked with writing a password generation program. In access I run a query to get the correct population and save it to a new table. I then (with VBA), open the recordset and append on a unique user ID and a randomly generated password. The program runs great however it takes 6-7 minutes, and sometimes locks up the computer. I was wondering if anything in the code stands out as a red flag.

The population I am working with is about 11,000 people

--Code Follows

Function CreateUser()
'Variables for loops and text

Dim num As Integer
Dim intloop As Integer
Dim encode As Integer
Dim cypher(62) As String
Dim pass As String
Dim pick As Integer
Dim count As Long
Const Lowerbound = 10000

'variables for swaps
Dim swap1 As Integer
Dim swap2 As Integer
Dim text1 As String
Dim text2 As String

'Variables for Database and reordsets
Dim db As Database
Dim rs As DAO.Recordset

'No Warnings
DoCmd.SetWarnings (False)

'Start randomizer
Randomize

encode = 1000 '1000 Randomizations
num = 48 '48 is start of basic ascii characters

For intloop = 0 To 61 'Fill aray with alphanumeric chars: 0-9 A-Z a-z

If num = 58 Then 'Skip non-alphanumerics
num = 65
End If

If num = 91 Then 'Skip non-alphanumerics
num = 97
End If

cypher(intloop) = Chr(num) 'Fill array

num = num + 1 'Next ascii char
Next

For intloop = 0 To encode 'Swap 2 random array spots 1000 times to ensure a random cypher

swap1 = Int((61 - 1 + 1) * Rnd) 'Get random spot1
swap2 = Int((61 - 1 + 1) * Rnd) 'Get random spot1

text1 = cypher(swap1) 'Assign to temp
text2 = cypher(swap2) 'Assign to temp

cypher(swap2) = text1 'Swap 2 to 1
cypher(swap1) = text2 'Swap 1 to 2

Next

'Connect to Databases
Set db = CurrentDb() 'Set as Default
Set rs = db.OpenRecordset("ElectId") 'Open for count

'Start counter
count = Lowerbound

Do Until rs.EOF 'Set values

rs.Edit

For intloop = 0 To 4 'Generate Passwd
pick = Int((61 - 1 + 1) * Rnd) 'Number between 1 and the length of the cypher string
pass = pass & cypher(pick)
Next

rs("UID") = count 'set the UID field
rs("PSWD") = pass 'Set PSWD field
rs.Update 'Update
rs.MoveNext 'Goto next record
count = count + 1 'UID conter is incremented
pass = ""
Loop

'Close recordsets
rs.Close

MsgBox ("Closing Database")

DoCmd.SetWarnings (True) 'Warnings back on

End Function

The last block is where it seems to hang (the edit portion). This is being run on an XP machine (SP2), with access 2002

Thanks for any assistance

[2887 byte] By [Code_Man888] at [2007-12-23]