如何最好地在MS Access中运行大型VBA循环而不冻结

Question

我有一个访问数据库[为了简化这个问题]一个表。该表包含150,000行和两个字段：F1和F2。我有一个VBA函数，它拉出表的DAO.Recordset然后迭代它。在循环中，我构建了一组200 F1.Value的字符串，然后查询Active Directory中的某些数据。然后我获取返回的数据并更新表中的F2，然后循环继续下一个200.

这一切都很好，但需要很长时间才能冻结Access。我试图找出如何使Access不冻结。理想情况下，我希望能够通过进度更新状态栏（例如Y的批次X）。

Public Function DoIt()
    Dim nRecordSet As DAO.Recordset
    Dim nRecordSetClone As DAO.Recordset
    Dim nFoundItem As Variant
    Dim nBatchCounter As Integer
    Dim nFilter As String
    Dim nFoundInAD As Collection

    ' to batch AD queries
    nBatchCounter = 0
    nFilter = ""

    ' the data
    Set nRecordSet = CurrentDb.OpenRecordset("SELECT [F1], [F2] FROM [Table1] WHERE [F2] Is Null")

    ' i clone it so i can move the cursor independent of the previous one
    Set nRecordSetClone = nRecordSet.Clone

    Do Until nRecordSet.EOF
        ' build the query string
        nFilter = nFilter + "(name=" & nRecordSet.Fields("F1").Value & ")"

        ' increment counter
        nBatchCounter = nBatchCounter + 1

        ' move the cursor to the next record
        nRecordSet.MoveNext

        ' check if I have a full batch or I am at the end of my records
        If nBatchCounter = 200 Or nRecordSet.EOF Then
            ' search AD
            ' nQueryAD.Query is a module.function I have to query AD using LDAP
            ' it returns a Collection of results
            ' this function can take time but it usually returns instantly
            Set nFoundInAD = nQueryAD.Query("(&(ObjectCategory=computer)(|" & nFilter & "))", "distinguishedName,name")

            ' make sure we actually found something
            If Not nFoundInAD Is Nothing Then
                If nFoundInAD.Count Then
                    ' iterate through each found
                    For Each nFoundItem In nFoundInAD

                        ' find the matching record in the clone and update it
                        nRecordSetClone.FindFirst "[F1] = '" & nFoundItem.Item("name") & "'"
                        nRecordSetClone.Edit
                        nRecordSetClone.Fields("F2").Value = nFoundItem.Item("distinguishedName")
                        nRecordSetClone.Update
                    Next nFoundItem
                End If
            End If

            ' reset batch stuff
            nBatchCounter = 0
            nFilter = ""
        End If
    Loop

    nRecordSetClone.Close
    nRecordSet.Close
    Set nRecordSet = Nothing
    Set nRecordSetClone = Nothing
    Set nFoundInAD = Nothing
End Function