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

Question

下午好，我需要一些帮助。有十几种方法可以做到我要问的技巧，但哪一种是最快的(我希望我忽略了一些)

我现在有两个方法，慢和超慢(2更快)

如果生成的随机数在链接表中不存在，则创建新记录。

表越大，代码运行越慢。在不久的将来，添加一些代码可能需要几天的时间。

添加记录的代码位:

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

也是函数

返回的随机字符串的代码位。

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

感谢您的帮助。

Answer 1

来回答我自己的问题…

通过保持记录集打开并添加带有'的新条目，我获得了很多性能。addNew '
在每个周期之后，我会。更新记录集以保存更改。
因为每个新条目将填充一个唯一的索引字段。当出现双值时，这可能最终引发3022错误
我将用errorhandler捕获此错误，并在更新之前恢复到Marker，并尝试在'之前的字段使用另一个值。更新'

是这样的:

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

如果有更多的性能要获得，那么请务必回复。永远喜欢学习更多!