签入链接表中记录不存在的最快方法

Question

Good afternoon, i require some help. there are dozen of methods that would do the trick that im about to ask but which would be fastest (i hopefull am overlooking some)

i've got 2 methods now, both slow and superslow (2 is faster)

the thing it does is create new records if generated random number doesnt already exist in linked table.

the bigger the table gets too populate, the slower the code will run. in near future it might probably take days to add just a few codes.

the bit of code that add's records:

Sub MakenNieuweNummers(AantalNieuweNummers As Long, strProduct As String, strBatch As String)
Dim strCode As String
Dim AantalNummersGemaakt As Long
Dim strSQL As String
'Vul hier het aantal nieuwe gewenste nummers in om de database mee uit te breiden

Do While AantalNummersGemaakt < AantalNieuweNummers
DoEvents
strCode = randomstring(6)
If DCount("code", "tblNummers", "code = '" & strCode & "'") = 0 Then

strSQL = "insert into tblNummers " & _
        "(code,actief,printdatum,product,batchnummer) " & _
        "VALUES ('" & strCode & "',TRUE,#" & Format(Date, "MM-DD-YYYY") & "#,'" & strProduct & "','" & strBatch & "')"
dbLocal().Execute strSQL
AantalNummersGemaakt = AantalNummersGemaakt + 1
End If

Loop

End Sub


Sub MakenNieuweNummers2(AantalNieuweNummers As Long, strProduct As String, strBatch As String)
Dim strCode As String
Dim AantalNummersGemaakt As Long
Dim strSQL As String
'Vul hier het aantal nieuwe gewenste nummers in om de database mee uit te breiden

Do While AantalNummersGemaakt < AantalNieuweNummers
DoEvents
strCode = randomstring(6)

If dbLocal().OpenRecordset("SELECT Count([ID]) AS [CountALL] FROM tblNummers WHERE code='" & strCode & "';")![CountALL] = 0 Then

strSQL = "insert into tblNummers " & _
        "(code,actief,printdatum,product,batchnummer) " & _
        "VALUES ('" & strCode & "',TRUE,#" & Format(Date, "MM-DD-YYYY") & "#,'" & strProduct & "','" & strBatch & "')"
dbLocal().Execute strSQL
AantalNummersGemaakt = AantalNummersGemaakt + 1
End If

Loop

End Sub

also the bit of code for the random strings that return from a function

Function randomstring(Optional iLengte As Integer) As String


If IsMissing(iLengte) Then
    iLengte = 6
End If
Randomize

Do While Len(randomstring) < iLengte
randomstring = randomstring & Mid(sReeks, Int((Len(sReeks)) * Rnd) + 1, 1)
Loop

End Function

Any help is greatly appreciated.

thanks in advance.

Answer 1

To answer my own question...

I've gained much in performance by keeping the recordset open and adding new entries with '.addNew'
after each cycle i will '.update' the recordset to save changes.
Because each new entry will fill an unique index field. this might eventually raise an error 3022 when a double occures
i will trap this error with the errorhandler and resume to an Marker just before the update and try another value for the field before '.Update'

This is what it looks like:

Sub MakenNieuweNummers(AantalNieuweNummers As Long, strProduct As String, strBatch As String)
On Error GoTo MakenNieuweNummers_err

Dim AantalNummersGemaakt As Long
Dim rst As DAO.Recordset

Set rst = dbLocal().OpenRecordset("tblNummers", , dbFailOnError)
With rst
  Do While AantalNummersGemaakt < AantalNieuweNummers
  DoEvents
  .AddNew

MakenNieuweNummers_next:
  !code = randomstring(6)
  .Update 'Error 3022 in case of double, will let errorhandler fix this.
  AantalNummersGemaakt = AantalNummersGemaakt + 1
  Loop
End With

MakenNieuweNummers_Exit:
  rst.Close
  Set rst = Nothing
  Exit Sub

MakenNieuweNummers_err:
If Err.Number = 3022 Then
  Resume MakenNieuweNummers_next
Else
  MsgBox Err.Number & vbNewLine & Err.Description, vbCritical
  Resume MakenNieuweNummers_Exit
End If
End Sub

If there is more performance to be gained, then please do reply. always love to learn more!