这个问题可能无法解决，但我想我会试一试。
我有一个VBA脚本（在Access 2010中运行），它打开一些记录集（ADOX），处理它们，并将结果写入本地Access表。有时这个处理需要几分钟;有时可能需要一个多小时。正在处理的实际数据足够相似，因此特定数据不应成为时差的原因。
当我以中断模式运行代码时（只需按住F8），没有明显的挂断 - 脚本似乎运行正常。
为了增加我的困惑，有时（但不总是）如果脚本运行缓慢，我暂停然后恢复（不进行其他更改），它将在恢复后快速运行。这让我觉得它可能是一个记录缓存问题，因此我将每个记录集的记录缓存增加到略高于该特定记录集的最大记录数，但这似乎没有任何影响。
有谁知道什么可能导致这些类型的波动，更重要的是，我可以做些什么来缓解它们？我可以在必要时发布代码，但考虑到暂停/恢复方案中相同代码的不同行为，我不确定问题是否基于代码。
提前致谢！
编辑：添加以下代码。 Do ... Loop Until循环是速度变化趋于发生的地方。该数据库是在Amazon Web Services上托管的MySQL。
Public Sub ReportTrueAdherenceNew(dtStart As Date, blRebuildIndexes As Boolean)
Dim lngScheduleLoadOrderID As Long
Dim dtEnd As Date
Dim dtShiftStart As Date
Dim dtShiftEnd As Date
Dim lngLCV As Long
Dim strIEXUID As String
Dim strFive9ID As String
Dim strMUNumID As String
Dim lngManagerID As Long
Dim lngTimeOffset As Long
Dim dbs As DAO.Database
Dim cn As ADODB.Connection
Dim cnFive9 As ADODB.Connection
Dim qdf As DAO.QueryDef
Dim strSQLAgentList(1 To 1, 1 To 3) As String
Dim strSQLAgentData(1 To 3, 1 To 3) As String
Dim strSQLAgentStateData(1 To 2, 1 To 3) As String
Dim strSQLMaintenance(1 To 2, 1 To 3) As String
Dim strSQLRebuildIndex(1 To 2, 1 To 3) As String
Dim rsAgentSchedule As ADODB.Recordset
Dim rsAgentState As ADODB.Recordset
Dim rsAgentList As ADODB.Recordset
Dim rsAgentDates As ADODB.Recordset
Dim rsAgentAdherent As ADODB.Recordset
Dim rsOOOEvents As ADODB.Recordset
Dim strOOOEvents As String
Dim lngAdherent As Long
Dim lngSchedStateID As Long
Dim lngActStateID As Long
Dim lngTotalAgents As LongPtr
Dim lngProcessingAgent As Long
Dim varReturn As Variant
Dim strAdherenceFile As String
Dim dtAS As Date
Dim rsSS As ADODB.Recordset
Dim rsAS As ADODB.Recordset
Dim rsADH As ADODB.Recordset
Dim strAgentLim As String
Dim strAgentsExclude As String
Dim strLogFile As String
Dim strMUs As String
strMUs = "1000,2000,6000"
strLogFile = "C:\Logs\ReportTrueAdherenceRecordset.txt"
LogToFile strLogFile, "Begin ReportTrueAdherenceRecordset for " & CStr(dtStart) & "..."
dtEnd = DateAdd("d", 1, dtStart)
lngScheduleLoadOrderID = 3
strSQLMaintenance(1, 1) = "qryADHTransfer"
strSQLMaintenance(1, 2) = "INSERT INTO tblAdherence (ScheduleDate, ScheduleMinute, IEXUID, Adherent, MUNumID, ManagerID, SchedStateID, AgentStateID) SELECT ScheduleDate, ScheduleMinute, IEXUID, Adherent, MUNumID, ManagerID, SchedStateID, AgentStateID FROM tblAdherenceLoad ORDER BY IEXUID, ScheduleDate, ScheduleMinute;"
strSQLMaintenance(1, 3) = "workforce_management"
strSQLMaintenance(2, 1) = "qryADHClearTemp"
strSQLMaintenance(2, 2) = "DELETE FROM tblAdherenceLoad;"
strSQLMaintenance(2, 3) = "workforce_management"
strSQLRebuildIndex(1, 1) = "qryAdherenceIndexesDrop"
strSQLRebuildIndex(1, 2) = "ALTER TABLE `workforce_management`.`tbladherence` " & _
"DROP FOREIGN KEY `fk_Adherence_IEXUID`, " & _
"DROP FOREIGN KEY `fk_Adherence_MUNumID`, " & _
"DROP FOREIGN KEY `fk_Adherence_ManagerID`, " & _
"DROP INDEX `idxScheduleDate`, " & _
"DROP INDEX `idxScheduleMinute`, " & _
"DROP INDEX `idxIEXUID`, " & _
"DROP INDEX `idxMUNumID`, " & _
"DROP INDEX `idxManagerID`;"
strSQLRebuildIndex(1, 3) = "ODBC;DSN=workforce_management;"
strSQLRebuildIndex(2, 1) = "qryAdherenceIndexesRebuild"
strSQLRebuildIndex(2, 2) = "ALTER TABLE `workforce_management`.`tbladherence` " & _
"ADD INDEX `idxScheduleDate` (`ScheduleDate` ASC), " & _
"ADD INDEX `idxScheduleMinute` (`ScheduleMinute` ASC), " & _
"ADD INDEX `idxIEXUID` (`IEXUID`), " & _
"ADD INDEX `idxMUNumID` (`MUNumID`), " & _
"ADD INDEX `idxManagerID` (`ManagerID`), " & _
"ADD CONSTRAINT `fk_Adherence_IEXUID` " & _
" FOREIGN KEY (`IEXUID`) " & _
" REFERENCES `workforce_management`.`tblAgentData` (`IEXUID`) " & _
" ON DELETE NO ACTION " & _
" ON UPDATE NO ACTION, " & _
"ADD CONSTRAINT `fk_Adherence_MUNumID` " & _
" FOREIGN KEY (`MUNumID`) " & _
" REFERENCES `workforce_management`.`tblmu` (`MUNumID`) " & _
" ON DELETE NO ACTION " & _
" ON UPDATE NO ACTION, " & _
"ADD CONSTRAINT `fk_Adherence_ManagerID` " & _
" FOREIGN KEY (`ManagerID`) " & _
" REFERENCES `workforce_management`.`tblmanager` (`ManagerID`) " & _
" ON DELETE NO ACTION " & _
" ON UPDATE NO ACTION;"
strSQLRebuildIndex(2, 3) = "ODBC;DSN=workforce_management;"
strAgentsExclude = ADHLoadIEXUID(dtStart)
If strAgentsExclude <> "" Then
strAgentLim = "AND ad.IEXUID NOT IN(" & strAgentsExclude & ") "
LogToFile strLogFile, "Excluded: " & strAgentsExclude
End If
strSQLAgentList(1, 1) = "qryAdherenceAgentList"
strSQLAgentList(1, 2) = "SELECT DISTINCT ad.IEXUID, ad.Five9ID, ad.MUNumID, ad.ManagerID, mu.TimeOffset " & _
"FROM tblAgentData ad " & _
"INNER JOIN tblAgentScheduleData asd ON ad.IEXUID = asd.IEXUID " & _
"INNER JOIN tblMU mu ON ad.MUNumID = mu.MUNumID " & _
"WHERE asd.ScheduleDate = '" & Format(dtStart, "YYYY-MM-DD") & "' AND mu.MUSetID IN(" & strMUs & ") AND asd.ScheduleActivity NOT IN(SELECT SchedState FROM tblSchedState WHERE InOffice=0) " & _
strAgentLim & _
"UNION SELECT a.IEXUID, ad.Five9ID, a.MUNumID, a.ManagerID, mu.TimeOffset " & _
"FROM tblAttendance a " & _
"LEFT JOIN (SELECT DISTINCT adh.MUNumID, adh.ManagerID, adh.IEXUID, adh.ScheduleDate FROM tblAdherence adh WHERE adh.ScheduleDate = '" & Format(dtStart, "YYYY-MM-DD") & "') adh2 ON a.IEXUID = adh2.IEXUID AND a.ScheduleDate = adh2.ScheduleDate " & _
"INNER JOIN tblAgentData ad ON a.IEXUID = ad.IEXUID " & _
"INNER JOIN tblMU mu ON a.MUNumID = mu.MUNumID " & _
"WHERE (adh2.IEXUID IS NULL AND adh2.ScheduleDate IS NULL) AND a.ScheduleDate = '" & Format(dtStart, "YYYY-MM-DD") & "' AND a.ScheduleDate <= (SELECT MAX(adh3.ScheduleDate) FROM tblAdherence adh3) AND a.MUSetID IN(" & strMUs & ") " & _
strAgentLim & _
"ORDER BY IEXUID;"
'Alternate list of those with attendance records but no longer in an active MU
strSQLAgentList(1, 3) = "workforce_management"
Set dbs = CurrentDb()
Set cn = New ADODB.Connection
cn.CursorLocation = adUseClient
cn.Open "DSN=workforce_management;"
DoCmd.SetWarnings False
If blRebuildIndexes Then
LogToFile strLogFile, "Dropping indexes on tblAdherence..."
cn.Execute strSQLRebuildIndex(1, 2)
LogToFile strLogFile, "Indexes dropped on tblAdherence..."
End If
Set rsOOOEvents = New ADODB.Recordset
rsOOOEvents.Open "SELECT SchedState FROM tblSchedState WHERE InOffice=0;", cn, adOpenForwardOnly, adLockReadOnly
Do
strOOOEvents = strOOOEvents & rsOOOEvents.Fields(0) & ";"
rsOOOEvents.MoveNext
Loop Until rsOOOEvents.EOF
rsOOOEvents.Close
Set rsOOOEvents = Nothing
Set rsAgentList = New ADODB.Recordset
rsAgentList.Open strSQLAgentList(1, 2), cn, adOpenStatic, adLockReadOnly
rsAgentList.CacheSize = 200
If Not (rsAgentList.BOF And rsAgentList.EOF) Then
LogToFile strLogFile, "Clearing temp table..."
dbs.Execute "DELETE * FROM tblAdherenceLoadLocal;"
lngTotalAgents = rsAgentList.RecordCount
LogToFile strLogFile, CStr(lngTotalAgents) & " total agents"
lngProcessingAgent = 1
Do
varReturn = Access.SysCmd(acSysCmdSetStatus, "Processing agent " & lngProcessingAgent & " of " & lngTotalAgents & " (" & CStr(dtStart) & ")")
strIEXUID = rsAgentList.Fields("IEXUID")
strFive9ID = rsAgentList.Fields("Five9ID")
strMUNumID = rsAgentList.Fields("MUNumID")
lngManagerID = rsAgentList.Fields("ManagerID")
lngTimeOffset = CInt(rsAgentList.Fields("TimeOffset")) + 2
LogToFile strLogFile, "Processing - Agent: " & strFive9ID & ", IEXUID: " & strIEXUID
strSQLAgentData(1, 1) = "qryAdherenceShiftStart"
strSQLAgentData(1, 2) = "SELECT MIN(tblAgentScheduleData.StartTime) AS ShiftStart, MAX(tblAgentScheduleData.EndTime) AS ShiftEnd " & _
"FROM tblAgentScheduleData " & _
"WHERE (((tblAgentScheduleData.IEXUID)=" & strIEXUID & ") AND ((tblAgentScheduleData.ScheduleDate)='" & Format(dtStart, "YYYY-MM-DD") & "') AND ScheduleLoadOrderID=" & lngScheduleLoadOrderID & ");"
strSQLAgentData(1, 3) = "workforce_management"
strSQLAgentData(2, 1) = "qryAdherenceSchedule"
strSQLAgentData(2, 2) = "SELECT tblAgentScheduleData.* " & _
"FROM tblAgentScheduleData " & _
"WHERE (((tblAgentScheduleData.IEXUID)=" & strIEXUID & ") AND ((tblAgentScheduleData.ScheduleDate)='" & Format(dtStart, "YYYY-MM-DD") & "') AND ScheduleLoadOrderID=" & lngScheduleLoadOrderID & ");"
strSQLAgentData(2, 3) = "workforce_management"
strSQLAgentData(3, 1) = "qryAdherenceActual"
strSQLAgentData(3, 2) = "SELECT five9_agent_state.*, DATE_ADD(Timestamp, INTERVAL " & lngTimeOffset & " HOUR) AS AdjTimestamp " & _
"FROM five9_agent_state " & _
"WHERE (((five9_agent_state.Agent_Email)='" & strFive9ID & "') AND ((five9_agent_state.Timestamp) Between '" & Format(dtStart, "YYYY-MM-DD") & "' And '" & Format(dtEnd, "YYYY-MM-DD") & "')) " & _
"ORDER BY timestamp;"
strSQLAgentData(3, 3) = "five9"
Set rsAgentDates = New ADODB.Recordset
rsAgentDates.Open strSQLAgentData(1, 2), cn, adOpenStatic, adLockReadOnly
dtShiftStart = CDate(dtStart & " " & TimeValue(Nz(rsAgentDates.Fields("ShiftStart"), #12:00:00 AM#)))
rsAgentDates.Close
Set rsAgentDates = Nothing
Set rsAgentSchedule = New ADODB.Recordset
rsAgentSchedule.Open strSQLAgentData(2, 2), cn, adOpenStatic, adLockReadOnly
rsAgentSchedule.CacheSize = 50
Set cnFive9 = New ADODB.Connection
cnFive9.Open "DSN=five9;"
Set rsAgentState = New ADODB.Recordset
rsAgentState.Open strSQLAgentData(3, 2), cnFive9, adOpenStatic, adLockReadOnly
rsAgentState.CacheSize = 200
If Not (rsAgentState.BOF And rsAgentState.EOF) Then
rsAgentState.MoveLast
rsAgentState.MoveFirst
End If
Set rsSS = New ADODB.Recordset
rsSS.Open "tblSchedState", cn, adOpenStatic, adLockReadOnly
rsSS.CacheSize = 50
If Not (rsAgentSchedule.BOF And rsAgentSchedule.EOF) Then
rsSS.MoveFirst
rsSS.Find "SchedState = '" & rsAgentSchedule.Fields("ScheduleActivity") & "'"
lngSchedStateID = rsSS.Fields("SchedStateID")
End If
Set rsAS = New ADODB.Recordset
rsAS.Open "tblAgentState", cn, adOpenStatic, adLockReadOnly
rsAS.CacheSize = 100
Set rsADH = New ADODB.Recordset
rsADH.Open "tblAdherentState", cn, adOpenStatic, adLockReadOnly
rsADH.CacheSize = 100
Do While dtShiftStart < dtShiftEnd
lngAdherent = 0
If Not (rsAgentState.BOF And rsAgentState.EOF) Then
If TimeValue(dtShiftStart) >= TimeValue(rsAgentSchedule.Fields("EndTime")) Then
rsAgentSchedule.MoveNext
rsSS.MoveFirst
rsSS.Find "SchedState = '" & rsAgentSchedule.Fields("ScheduleActivity") & "'"
lngSchedStateID = rsSS.Fields("SchedStateID")
End If
rsAgentState.Find "AdjTimestamp>#" & dtShiftStart & "#"
If Not rsAgentState.BOF Then rsAgentState.MovePrevious
If Not rsAgentState.BOF Then
If rsAgentState.Fields("Agent_State_Time") = "24:00:00" Then
dtAS = 0
Else
dtAS = rsAgentState.Fields("Agent_State_Time")
End If
' If TimeValue(dtShiftStart) > DateAdd("h", lngTimeOffset, TimeValue(rsAgentState.Fields("Timestamp")) + TimeValue(rsAgentState.Fields("Agent_State_Time"))) Then
If TimeValue(dtShiftStart) > DateAdd("h", lngTimeOffset, TimeValue(rsAgentState.Fields("Timestamp")) + dtAS) Then
rsAgentState.MoveNext
End If
End If
If Not (rsAgentState.BOF Or rsAgentState.EOF) Then
rsAS.MoveFirst
rsAS.Find "AgentState = '" & rsAgentState.Fields("Agent_State") & "'"
lngActStateID = rsAS.Fields("AgentStateID")
rsADH.MoveFirst
rsADH.Filter = "SchedStateID = " & lngSchedStateID & " AND AgentStateID = " & lngActStateID
If Not (rsADH.BOF And rsADH.EOF) Then lngAdherent = 1
rsADH.Filter = ""
Else
lngActStateID = 10
End If
End If
If InStr(1, strOOOEvents, rsAgentSchedule.Fields("ScheduleActivity"), vbTextCompare) = 0 Then
dbs.Execute "INSERT INTO tblAdherenceLoadLocal (ScheduleDate, ScheduleMinute, IEXUID, Adherent, MUNumID, ManagerID, SchedStateID, AgentStateID) " & _
"VALUES (#" & dtStart & "#,#" & dtShiftStart & "#," & strIEXUID & "," & lngAdherent & "," & strMUNumID & "," & lngManagerID & "," & lngSchedStateID & "," & lngActStateID & ");"
End If
dtShiftStart = DateAdd("n", 1, dtShiftStart)
Loop
rsSS.Close
rsAS.Close
rsADH.Close
rsAgentSchedule.Close
rsAgentState.Close
cnFive9.Close
Set rsSS = Nothing
Set rsAS = Nothing
Set rsADH = Nothing
Set rsAgentSchedule = Nothing
Set rsAgentState = Nothing
Set cnFive9 = Nothing
If Not rsAgentList.EOF Then rsAgentList.MoveNext
lngProcessingAgent = lngProcessingAgent + 1
LogToFile strLogFile, "Completed Processing: " & strFive9ID
Loop Until rsAgentList.EOF
Else
LogToFile strLogFile, "No agents selected"
End If
LogToFile strLogFile, "Completed All Agents;Begin Upload to MYSQL"
varReturn = Access.SysCmd(acSysCmdSetStatus, "Inserting processed records")
LogToFile strLogFile, "Generating output file..."
strAdherenceFile = "C:\Temp\" & Format(dtStart, "YYYYMMDD") & "AdherenceFile.csv"
DoCmd.TransferText acExportDelim, , "qryTrueAdherenceExport", strAdherenceFile, False
strAdherenceFile = VBA.Replace(strAdherenceFile, "\", "\\")
Set qdf = New DAO.QueryDef
qdf.Name = "qryTrueAdherenceTransfer"
qdf.Connect = "ODBC;DSN=workforce_management;"
qdf.SQL = "LOAD DATA LOW_PRIORITY LOCAL INFILE '" & strAdherenceFile & "' INTO TABLE workforce_management.tblAdherence FIELDS TERMINATED BY ',' ( @dummy, @var1, @var2, IEXUID, Adherent, MUNumID, ManagerID, SchedStateID, AgentStateID ) SET ScheduleDate = DATE_FORMAT(STR_TO_DATE(@var1, '%m/%d/%Y %H:%i:%s'), '%Y-%m-%d'), ScheduleMinute = DATE_FORMAT(STR_TO_DATE(@var2, '%m/%d/%Y %H:%i:%s'), '%H:%i:%s');"
qdf.ReturnsRecords = False
qdf.ODBCTimeout = 600
dbs.QueryDefs.Append qdf
Set qdf = Nothing
LogToFile strLogFile, "Importing results to server..."
dbs.Execute "qryTrueAdherenceTransfer"
dbs.QueryDefs.Delete "qryTrueAdherenceTransfer"
varReturn = Access.SysCmd(acSysCmdSetStatus, "Clearing temp tables...")
LogToFile strLogFile, "Clearing temp table..."
dbs.Execute "DELETE * FROM tblAdherenceLoadLocal;"
For lngLCV = LBound(strSQLMaintenance, 1) To UBound(strSQLMaintenance, 1)
If ExistObject(strSQLMaintenance(lngLCV, 1), acQuery) Then dbs.QueryDefs.Delete strSQLMaintenance(lngLCV, 1)
Set qdf = New DAO.QueryDef
qdf.Name = strSQLMaintenance(lngLCV, 1)
qdf.SQL = strSQLMaintenance(lngLCV, 2)
qdf.Connect = "ODBC;DSN=" & strSQLMaintenance(lngLCV, 3) & ";"
qdf.ReturnsRecords = False
dbs.QueryDefs.Append qdf
qdf.Execute
Set qdf = Nothing
If ExistObject(strSQLMaintenance(lngLCV, 1), acQuery) Then dbs.QueryDefs.Delete strSQLMaintenance(lngLCV, 1)
Next lngLCV
LogToFile strLogFile, "Temp tables cleared."
If blRebuildIndexes Then
varReturn = Access.SysCmd(acSysCmdSetStatus, "Rebuilding database indexes...")
LogToFile strLogFile, "Rebuilding indexes on tblAdherence..."
If ExistObject(strSQLRebuildIndex(2, 1), acQuery) Then dbs.QueryDefs.Delete strSQLRebuildIndex(2, 1)
Set qdf = New DAO.QueryDef
qdf.Name = strSQLRebuildIndex(2, 1)
qdf.SQL = strSQLRebuildIndex(2, 2)
qdf.Connect = strSQLRebuildIndex(2, 3)
qdf.ReturnsRecords = False
qdf.ODBCTimeout = 180
dbs.QueryDefs.Append qdf
Set qdf = Nothing
dbs.Execute strSQLRebuildIndex(2, 1)
LogToFile strLogFile, "Indexes rebuilt on tblAdherence..."
dbs.QueryDefs.Delete strSQLRebuildIndex(2, 1)
End If
varReturn = Access.SysCmd(acSysCmdClearStatus)
DoCmd.SetWarnings True
LogToFile strLogFile, "Process completed successfully"
cn.Close
Set cn = Nothing
Set dbs = Nothing
End Sub