加速 Access 数据库
Speeding up an Access Database
我有一个 Access 数据库来报告从大型机系统收集的事件统计信息。大型机调度程序 (ZEKE) 没有强大的报告功能，因此我导出每日事件数据以进行报告。
来自单独来源的主列表（不会定期更改的静态列表）列出了各个应用程序，包括应用程序代码（这是生产 运行s 的命名标准）和该应用程序的程序员、协调员、经理、业务部门等的姓名。
用户可以按任何领域、应用代码、程序员、协调员等进行搜索
选择要搜索的产地（有5个）或默认全部，并选择所有日期、单个日期或日期范围。
该查询采用搜索参数并从应用程序代码或人员开始，在 table 中搜索应用程序并将记录复制到临时 table 以进行报告。
例如，要查看应用程序协调员 John Doe 在过去一周中他负责的所有应用程序有多少次失败，查询会将列有 John Doe 作为协调员的所有应用程序记录移动到临时 table.
从那里开始，它通过每个应用程序的临时 table 并在事件数据中搜索该应用程序代码下的事件，这些事件符合为日期、生产中心和事件类型（成功、失败或两者）输入的标准。
这已移至最终报告的临时 table。
事件数据的 table 当前为 250 万行（这是 15 天的数据）并且每天都在增长。
我将后端放到我们网络上新创建的 NAS 驱动器上。
后端和前端在同一台机器上时需要两分钟的报告现在需要 29 分钟。
有什么简化网络查询的建议吗？
来自报告标准选择表和 运行 报告的 运行 代码。
'this macro will generate a report based on multiple input criteria.
'this report allows the user to slect:
' date range, single date or all dates
' type of events: Abends, Successes or both
' centers to pull data from: OCC,QCC,BCC,ITS,DAIN, or ALL centers
' The type of data to report on: App code, App Coordinator, Custodian, L3, L4 or L5
'Once the user has selected all of the required data and fields, the report will be generated
'based on the selection criteria.
'we begin by defining the active database as the currently open database
Dim db As DAO.Database
Set db = DBEngine(0)(0)
On Error GoTo ErrorHandler
'Now we designate the variables which will be used in this macro
Dim strSQ1 As String
Dim strSQ2 As String
Dim strSQ3 As String
Dim strSQ4 As String
Dim appl As String
Dim evstatus As String
Dim appletype As String
Dim fullapp As String
Dim length As Long
Dim iipmname As String
Dim iipmcoor As String
Dim fullappnm As String
Dim fullappcoor As String
Dim kinddate As String
Dim coor As String
Dim cust As String
Dim appL3 As String
Dim appL4 As String
Dim appL5 As String
Dim ctrOCC As String
Dim ctrMTL As String
Dim ctrBCC As String
Dim ctrITS As String
Dim ctrDAIN As String
'We will start by setting some default values
'We will ste the default values for center selection.
'We start by searching for terms we know are not there, then change them to
'valid search terms if the center is selected.
ctrOCC = "notOCC"
ctrMTL = "notMTL"
ctrBCC = "notBCC"
ctrITS = "notITS"
ctrDAIN = "notUSWM"
fullapp = "*"
'First we determine which event types the user wants to look for
state = Me![opt-status].Value
If state = 1 Then
evstatus = " [ev-status] = 'AEOJ'"
ElseIf state = 2 Then
evstatus = " [ev-status] = 'EOJ'"
ElseIf state = 3 Then
evstatus = " ([ev-status] = 'EOJ' OR [ev-status] = 'AEOJ')"
End If
'MsgBox "Event status pulled is:.. " & evstatus & "."
' Next up we will configure the date parameters based on the user input
If [grp-datesel] = 1 Then
Sdte = "1"
Edte = "9999999"
kinddate = "[ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & " "
End If
If [grp-datesel] = 2 Then
'error handling
If IsNull(Me.[sel-onedate]) Then
MsgBox "You have not entered a date to search....please try again."
Me.[sel-onedate] = Null
Me.[sel-onedate].SetFocus
Exit Sub
End If
'end of error handling
Dim currdte As Date
currdte = Me![sel-onedate].Value
currjul = Format(currdte, "yyyyy")
daycurr = CDbl(currjul)
Sdte = daycurr
Edte = daycurr
kinddate = "[ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & " "
End If
If [grp-datesel] = 3 Then
'error handling
If IsNull(Me.[sel-Sdate]) Or IsNull(Me.[sel-Edate]) Then
MsgBox "You Must enter a start and end date for the search....please try again."
Me.[sel-Sdate] = Null
Me.[sel-Edate] = Null
Me.[sel-Sdate].SetFocus
Exit Sub
End If
'end of error handling
Dim startdte As Date
Dim enddte As Date
startdte = Me.[sel-Sdate].Value
enddte = Me.[sel-Edate].Value
startjul = Format(startdte, "yyyyy")
endjul = Format(enddte, "yyyyy")
Sday = CDbl(startjul)
Eday = CDbl(endjul)
Sdte = Sday
Edte = Eday
'MsgBox "start date is " & Sdte & " and end date is " & Edte & "."
'check that dates are in proper chronological order
If Sdte > Edte Then
MsgBox "The start Date you entered is after the end date....please try again."
Me.[sel-Sdate] = Null
Me.[sel-Edate] = Null
Me.[sel-Sdate].SetFocus
Exit Sub
End If
'keep going if it's all good
kinddate = "[ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & " "
End If
MsgBox "Date used is:.. " & kinddate & "."
'Now lets look at center selection
If [chk-allctr].Value = True Then
ctrOCC = "OCC"
ctrMTL = "MTL"
ctrBCC = "BCC"
ctrITS = "ITS"
ctrDAIN = "USWM"
End If
If [chk-OCC].Value = True Then
ctrOCC = "OCC"
End If
If [chk-MTL].Value = True Then
ctrMTL = "MTL"
End If
If [chk-BCC].Value = True Then
ctrBCC = "BCC"
End If
If [chk-RTF].Value = True Then
ctrITS = "ITS"
End If
If [chk-DAIN].Value = True Then
ctrDAIN = "DAIN"
End If
'Error handling if no center is selected
If [chk-OCC].Value = Flase Then
If [chk-MTL].Value = Flase Then
If [chk-BCC].Value = Flase Then
If [chk-RTF].Value = Flase Then
If [chk-DAIN].Value = Flase Then
MsgBox "You have not selected a center to search search....please try again."
Me.[chk-allctr].SetFocus
Exit Sub
End If
End If
End If
End If
End If
'end of error handling
'MsgBox "centers used are: Chr(10) " & ctrOCC & " Chr(10) " & ctrBCC & " Chr(10) " & ctrMTL & " Chr(10) " & ctrITS & " Chr(10) " & ctrDAIN & " For this run"
'All good so far, now we will parse the application code if an
'application code report is selected
appl = "*"
If [opt-criteria].Value = 1 Then
'error handling
If IsNull(Me.[sel-appcode]) Then
MsgBox "You have not entered an application code to search....please try again."
Me.[sel-appcode] = Null
Me.[sel-appcode].SetFocus
Exit Sub
End If
'end of error handling
End If
If [opt-criteria].Value = 1 Then
appl = Me![sel-appcode].Value
End If
'trust = "no"
'If Mid(appl, 3, 2) = "RT" Then trust = "yes"
'length = Len(appl)
'If length = 2 Then appltype = "short"
'If length = 3 Then appltype = "long"
'If appltype = "short" Then fullapp = "" & appl & "00"
'If appltype = "long" Then fullapp = "" & appl & "0"
'If trust = "yes" Then fullapp = appl
'End If
fullapp = appl
'MsgBox "App to use is: " & appl & " fullapp code is " & fullapp & "."
'Now we set values if names are used
coor = "*"
cust = "*"
appL3 = "*"
appL4 = "*"
appL5 = "*"
If [opt-criteria].Value = 2 Then
'error handling
If IsNull(Me.[sel-coor]) Then
MsgBox "You have not entered a Coordinator to search....please try again."
Me.[sel-coor] = Null
Me.[sel-coor].SetFocus
Exit Sub
End If
'end of error handling
coor = Me![sel-coor].Value
'MsgBox "Coordinator report selected for: " & coor & "."
End If
If [opt-criteria].Value = 3 Then
'error handling
If IsNull(Me.[sel-custodian]) Then
MsgBox "You have not entered a Custodian to search....please try again."
Me.[sel-custodian] = Null
Me.[sel-custodian].SetFocus
Exit Sub
End If
'end of error handling
cust = Me![sel-custodian].Value
'MsgBox "Custodian report selected for: " & cust & "."
End If
If [opt-criteria].Value = 4 Then
'error handling
If IsNull(Me.[sel-L3]) Then
MsgBox "You have not entered an L3 to search....please try again."
Me.[sel-L3] = Null
Me.[sel-L3].SetFocus
Exit Sub
End If
'end of error handling
appL3 = Me![sel-L3].Value
'MsgBox "L3 report selected for: " & appL3 & "."
End If
If [opt-criteria].Value = 5 Then
'error handling
If IsNull(Me.[sel-L4]) Then
MsgBox "You have not entered an L4 to search....please try again."
Me.[sel-L4] = Null
Me.[sel-L4].SetFocus
Exit Sub
End If
'end of error handling
appL4 = Me![sel-L4].Value
'MsgBox "L4 report selected for: " & appL4 & "."
End If
If [opt-criteria].Value = 6 Then
'error handling
If IsNull(Me.[sel-L5]) Then
MsgBox "You have not entered an L5 to search....please try again."
Me.[sel-L5] = Null
Me.[sel-L5].SetFocus
Exit Sub
End If
'end of error handling
appL5 = Me![sel-L5].Value
'MsgBox "L5 report selected for: " & appL5 & "."
End If
'Most of these reports take a while to build with this macro, so to make sure the user
'knows that the macro is still working, we didsplay a splash screen. It's cute and has
'hamsters, cause everyone loves hamsters.
DoCmd.OpenForm "PlsWaitFrm", acWindowNormal
[Forms]![PlsWaitFrm].Repaint
'All of out criteria values are now selected. We can move on to pulling data from the tables.
'We start by populating the IIPM table with the information that we require for applications.
strSQ1 = "DELETE * from [tbl-RPT-IIPM] "
db.Execute strSQ1
strSQ2 = "INSERT INTO [tbl-RPT-IIPM] " & _
"SELECT * FROM [tbl-IIPM] " & _
"WHERE (([AppCode] like '" & fullapp & "')" & _
"AND ([AppCoordinator] like '" & coor & "') " & _
"AND ([AppCustodian] like '" & cust & "') " & _
"AND ([L3] like '" & appL3 & "') " & _
"AND ([L4] like '" & appL4 & "') " & _
"AND ([L5] like '" & appL5 & "')) "
db.Execute strSQ2
'MsgBox "made it past the populate of rpt-iipm"
'Now we have populated the IIPM report table, it's time to populate the event report table.
'We will loop through all fields in the IIPM report table and pull information for each
'application code.
strSQ3 = "DELETE * from [tbl-EVENTREPORT] "
db.Execute strSQ3
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl-RPT-IIPM") 'this opens the IIPM report table just populated
'populate the table
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
'we will execute these action against the selected record.
'first step - parse the application code to display the full application code
appl = rs![AppCode].Value
length = Len(appl)
If length = 1 Then appl = "" & appl & "00"
rptdelin = Mid(appl, 3, 1)
rptcode = Mid(appl, 1, 3)
If rptdelin = "0" Then rptcode = Mid(appl, 1, 2)
If rptdelin = "R" Then rptcode = "RT" & Mid(appl, 1, 2) & ""
'MsgBox "searching for: " & rptcode & "."
applist = applist & "," & appl
strSQ4 = "INSERT INTO [tbl-EVENTREPORT] " & _
"SELECT * FROM [tbl-EVENT DATA] " & _
"WHERE (([ev-jobname] LIKE '?" & rptcode & "*') " & _
"AND (([ev-ctr] = '" & ctrOCC & "')" & _
"OR ([ev-ctr] = '" & ctrMTL & "')" & _
"OR ([ev-ctr] = '" & ctrBCC & "')" & _
"OR ([ev-ctr] = '" & ctrITS & "')" & _
"OR ([ev-ctr] = '" & ctrDAIN & "'))" & _
"AND (" & kinddate & ") " & _
"AND " & evstatus & ")"
db.Execute strSQ4
'now we're done with this report, we move on to the next
rs.MoveNext 'press Ctrl+G to see debuG window beneath
Loop
'END OF LOOPING CODE
'MsgBox "made it past the looping"
'Now we have completed populating the table that the report will be based on.
'Next step is to gather master statistics to produce abend and success percentages.
totfail = DCount("[ev-status]", "tbl-EVENTREPORT", "[ev-status] = 'AEOJ'")
totsucc = DCount("[ev-status]", "tbl-EVENTREPORT", "[ev-status] = 'EOJ'")
Dim allabend As Long
Dim allsucc As Long
allabend = DCount("[ev-status]", "[tbl-EVENT DATA]", "[ev-status] = 'AEOJ' AND ([ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & ")")
allsucc = DCount("[ev-status]", "[tbl-EVENT DATA]", "[ev-status] = 'EOJ' AND ([ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & ")")
Dim pctabend As Long
Dim pctsucc As Long
pctabend = (totfail / allabend) * 100
pctsucc = (totsucc / allsucc) * 100
'Now we will generate the reports for display based on what type of report was selected
'by the user in the initial form.
'Before we open the report, we will close the splash screen
DoCmd.Close acForm, "PlsWaitFrm", acSaveNo
'Now we open the report
If [opt-criteria].Value = 1 Then
fullappnm = DLookup("AppName", "tbl-RPT-IIPM", "AppCode = '" & fullapp & "' ")
fullappcoor = DLookup("AppCoordinator", "tbl-RPT-IIPM", "AppCode = '" & fullapp & "' ")
DoCmd.OpenReport "rpt-APPLREPORT", acViewReport
[Reports]![rpt-APPLREPORT]![rpt-appcode].Value = fullapp
[Reports]![rpt-APPLREPORT]![rpt-appname].Value = fullappnm
[Reports]![rpt-APPLREPORT]![rpt-appcoor].Value = fullappcoor
[Reports]![rpt-APPLREPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-APPLREPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-APPLREPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-APPLREPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 2 Then
DoCmd.OpenReport "rpt-COORREPORT", acViewReport
[Reports]![rpt-COORREPORT]![rpt-appcode].Value = applist
[Reports]![rpt-COORREPORT]![rpt-appcoor].Value = coor
[Reports]![rpt-COORREPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-COORREPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-COORREPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-COORREPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 3 Then
DoCmd.OpenReport "rpt-CUSTREPORT", acViewReport
[Reports]![rpt-CUSTREPORT]![rpt-appcode].Value = applist
[Reports]![rpt-CUSTREPORT]![rpt-appcoor].Value = cust
[Reports]![rpt-CUSTREPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-CUSTREPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-CUSTREPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-CUSTREPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 4 Then
DoCmd.OpenReport "rpt-L3REPORT", acViewReport
[Reports]![rpt-L3REPORT]![rpt-appcode].Value = applist
[Reports]![rpt-L3REPORT]![rpt-appcoor].Value = appL3
[Reports]![rpt-L3REPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-L3REPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-L3REPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-L3REPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 5 Then
DoCmd.OpenReport "rpt-L4REPORT", acViewReport
[Reports]![rpt-L4REPORT]![rpt-appcode].Value = applist
[Reports]![rpt-L4REPORT]![rpt-appcoor].Value = appL4
[Reports]![rpt-L4REPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-L4REPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-L4REPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-L4REPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 6 Then
DoCmd.OpenReport "rpt-L5REPORT", acViewReport
[Reports]![rpt-L5REPORT]![rpt-appcode].Value = applist
[Reports]![rpt-L5REPORT]![rpt-appcoor].Value = appL5
[Reports]![rpt-L5REPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-L5REPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-L5REPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-L5REPORT]![rpt-succpct].Value = pctsucc
End If
ErrorHandler:
If Err.Number = 7874 Then
Resume Next 'Tried to delete a non-existing table, resume
End If
End Sub
'''
首先，您需要找出瓶颈所在，因此我建议在整个代码中放置一些 Debug.Print Now 语句，让您了解导致问题的原因。
我猜想花费大部分时间的两个过程是您正在执行的 DELETE/INSERT 语句。
我建议您不要这样做，而是考虑规范化您的数据库，然后创建一个查询来提供您需要的信息。
此外，通过 运行 直接从查询而不是临时报告 table 意味着您不必担心 deletes/inserts 造成数据库膨胀。
如果你真的坚持要保留这个过程，那么考虑删除table [tbl-RPT-IIPM] 然后重新创建它，而不是删除记录。并考虑在插入之前删除索引，然后再将它们添加回来，因为索引会减慢插入速度，但显然会加快搜索和连接速度。
此外，当您向 [tbl-RPT-IIPM] 中插入数据时，您使用的是 ([L3] like '" & appL3 & "')，这与 ([L3]='" & appL3 & "') 相同，但速度较慢。
当您向 [tbl-EVENTREPORT] 中插入数据时，您是在遍历记录集时执行此操作 - 使用 INSERT SQL 语句可能更快。
此致，
Applecore，首先感谢您的见解。不幸的是，由于数据处理方式的性质，我不确定其中一些是否可以实现。我使用 debug.print 语句来更好地了解时间。
你说得对，INSERT 语句给我带来的问题最多，而且仅次于此。删除几乎立即飞过，没有问题。它是事件数据中的第二个插入，这会减慢它的速度。
从一开始我就一直在思考如何更有效地恋爱并建立更好的关系，但我受阻了。我的问题是，事件 table 和事件 table 之间的数据是相关的 "in the world" 但在数据方面没有明确的方式。没有复杂的计算就无法确定关系。例如，应用程序数据的唯一部分是应用程序代码。他们总是独一无二的。单个应用程序协调器可以分配给它们许多代码，保管人、L3、L4 等也可以。每个事件都与一个应用程序相关，但是，没有导出的特定字段告诉应用程序代码，它是获得的通过解析事件名称（是的，这听起来很陈旧）。事件命名标准是标准的大型机 8 字符名称： .
例如 PGRD1234 - 生产作业，GRD 应用程序，1234 作为指示符。因此，为了确定该工作与哪个应用程序相关，我采用了应用程序代码，并使用通配符 select LIKE。我很清楚这不是 100% 准确，但要使用通配符，我似乎无法使用 LIKE。我无法使“=”与通配符一起工作。你是否可以？
您还提到了 "When you are inserting data into [tbl-EVENTREPORT], you are doing it when looping through a recordset - it may be faster to use an INSERT SQL statement."，我不确定您在说什么。抱歉。我不认为我理解它。我想这就是我现在正在做的。我使用 IIPM table 获取我需要提取的应用程序代码列表，然后遍历该记录集以仅提取那些应用程序的所有事件数据。由于数据之间没有直接关联，我想不出另一种方法来做到这一点。
好的，有了更多的信息，更多的答案可能（也可能不会！！）有帮助。同样，您将需要 运行 计时测试以查看哪种最适合您。
尝试将 "Yes/No" 字段添加到 table [tbl-EVENT DATA]。然后，您可以使用 UPDATE 语句来指示要在报告中包含哪些字段，而不是使用缓慢的 INSERT 查询。
另一种尝试是将 INSERT 语句替换为多个语句，每个语句使用 [ev-ctr] 的不同值。或者不要使用 OR 尝试使用 IN:
strSQ4 = "INSERT INTO [tbl-EVENTREPORT] " & _
"SELECT * FROM [tbl-EVENT DATA] " & _
"WHERE [ev-jobname] LIKE '?" & rptcode & "*' " & _
"AND [ev-ctr] IN('" & ctrOCC & "','" & ctrMTL & "','" & ctrBCC & "','" & ctrITS & "','" & ctrDAIN & "')" & _
"AND " & kinddate & _
"AND " & evstatus
此外，我注意到 kinddate 设置为在一个实例中有效地包含所有日期，而 evstatus 设置为同时包含 "EOJ" 和 "AEOJ"一个实例。在这些情况下，与其将这些字段作为条件包括在内，您可能希望完全不包括它们：
If state = 1 Then
evstatus = " AND [ev-status] = 'AEOJ'"
ElseIf state = 2 Then
evstatus = " AND [ev-status] = 'EOJ'"
ElseIf state = 3 Then
evstatus = " "
End If
然后在 SQL 语句中将 " AND " & evstatus 重写为 & evstatus。
最后要看的是实际上直接在后端 运行 INSERT，而不是在前端对链接的 table 进行操作，因为 Access 会拖通过网络传输大量数据，然后将其发回。作为基本指南，如下所示：
Sub sUpdateQuery()
Dim objAccess As New Access.Application
objAccess.OpenCurrentDatabase "J:\downloads\test.accdb"
objAccess.DoCmd.RunSQL "UPDATE test2 SET Field1=UCASE(Field1);"
objAccess.CloseCurrentDatabase
Set objAccess = Nothing
End Sub
此致，
我有一个 Access 数据库来报告从大型机系统收集的事件统计信息。大型机调度程序 (ZEKE) 没有强大的报告功能，因此我导出每日事件数据以进行报告。
来自单独来源的主列表（不会定期更改的静态列表）列出了各个应用程序，包括应用程序代码（这是生产 运行s 的命名标准）和该应用程序的程序员、协调员、经理、业务部门等的姓名。
用户可以按任何领域、应用代码、程序员、协调员等进行搜索
选择要搜索的产地（有5个）或默认全部，并选择所有日期、单个日期或日期范围。
该查询采用搜索参数并从应用程序代码或人员开始，在 table 中搜索应用程序并将记录复制到临时 table 以进行报告。
例如，要查看应用程序协调员 John Doe 在过去一周中他负责的所有应用程序有多少次失败，查询会将列有 John Doe 作为协调员的所有应用程序记录移动到临时 table.
从那里开始，它通过每个应用程序的临时 table 并在事件数据中搜索该应用程序代码下的事件，这些事件符合为日期、生产中心和事件类型（成功、失败或两者）输入的标准。
这已移至最终报告的临时 table。
事件数据的 table 当前为 250 万行（这是 15 天的数据）并且每天都在增长。
我将后端放到我们网络上新创建的 NAS 驱动器上。
后端和前端在同一台机器上时需要两分钟的报告现在需要 29 分钟。
有什么简化网络查询的建议吗？
来自报告标准选择表和 运行 报告的 运行 代码。
'this macro will generate a report based on multiple input criteria.
'this report allows the user to slect:
' date range, single date or all dates
' type of events: Abends, Successes or both
' centers to pull data from: OCC,QCC,BCC,ITS,DAIN, or ALL centers
' The type of data to report on: App code, App Coordinator, Custodian, L3, L4 or L5
'Once the user has selected all of the required data and fields, the report will be generated
'based on the selection criteria.
'we begin by defining the active database as the currently open database
Dim db As DAO.Database
Set db = DBEngine(0)(0)
On Error GoTo ErrorHandler
'Now we designate the variables which will be used in this macro
Dim strSQ1 As String
Dim strSQ2 As String
Dim strSQ3 As String
Dim strSQ4 As String
Dim appl As String
Dim evstatus As String
Dim appletype As String
Dim fullapp As String
Dim length As Long
Dim iipmname As String
Dim iipmcoor As String
Dim fullappnm As String
Dim fullappcoor As String
Dim kinddate As String
Dim coor As String
Dim cust As String
Dim appL3 As String
Dim appL4 As String
Dim appL5 As String
Dim ctrOCC As String
Dim ctrMTL As String
Dim ctrBCC As String
Dim ctrITS As String
Dim ctrDAIN As String
'We will start by setting some default values
'We will ste the default values for center selection.
'We start by searching for terms we know are not there, then change them to
'valid search terms if the center is selected.
ctrOCC = "notOCC"
ctrMTL = "notMTL"
ctrBCC = "notBCC"
ctrITS = "notITS"
ctrDAIN = "notUSWM"
fullapp = "*"
'First we determine which event types the user wants to look for
state = Me![opt-status].Value
If state = 1 Then
evstatus = " [ev-status] = 'AEOJ'"
ElseIf state = 2 Then
evstatus = " [ev-status] = 'EOJ'"
ElseIf state = 3 Then
evstatus = " ([ev-status] = 'EOJ' OR [ev-status] = 'AEOJ')"
End If
'MsgBox "Event status pulled is:.. " & evstatus & "."
' Next up we will configure the date parameters based on the user input
If [grp-datesel] = 1 Then
Sdte = "1"
Edte = "9999999"
kinddate = "[ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & " "
End If
If [grp-datesel] = 2 Then
'error handling
If IsNull(Me.[sel-onedate]) Then
MsgBox "You have not entered a date to search....please try again."
Me.[sel-onedate] = Null
Me.[sel-onedate].SetFocus
Exit Sub
End If
'end of error handling
Dim currdte As Date
currdte = Me![sel-onedate].Value
currjul = Format(currdte, "yyyyy")
daycurr = CDbl(currjul)
Sdte = daycurr
Edte = daycurr
kinddate = "[ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & " "
End If
If [grp-datesel] = 3 Then
'error handling
If IsNull(Me.[sel-Sdate]) Or IsNull(Me.[sel-Edate]) Then
MsgBox "You Must enter a start and end date for the search....please try again."
Me.[sel-Sdate] = Null
Me.[sel-Edate] = Null
Me.[sel-Sdate].SetFocus
Exit Sub
End If
'end of error handling
Dim startdte As Date
Dim enddte As Date
startdte = Me.[sel-Sdate].Value
enddte = Me.[sel-Edate].Value
startjul = Format(startdte, "yyyyy")
endjul = Format(enddte, "yyyyy")
Sday = CDbl(startjul)
Eday = CDbl(endjul)
Sdte = Sday
Edte = Eday
'MsgBox "start date is " & Sdte & " and end date is " & Edte & "."
'check that dates are in proper chronological order
If Sdte > Edte Then
MsgBox "The start Date you entered is after the end date....please try again."
Me.[sel-Sdate] = Null
Me.[sel-Edate] = Null
Me.[sel-Sdate].SetFocus
Exit Sub
End If
'keep going if it's all good
kinddate = "[ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & " "
End If
MsgBox "Date used is:.. " & kinddate & "."
'Now lets look at center selection
If [chk-allctr].Value = True Then
ctrOCC = "OCC"
ctrMTL = "MTL"
ctrBCC = "BCC"
ctrITS = "ITS"
ctrDAIN = "USWM"
End If
If [chk-OCC].Value = True Then
ctrOCC = "OCC"
End If
If [chk-MTL].Value = True Then
ctrMTL = "MTL"
End If
If [chk-BCC].Value = True Then
ctrBCC = "BCC"
End If
If [chk-RTF].Value = True Then
ctrITS = "ITS"
End If
If [chk-DAIN].Value = True Then
ctrDAIN = "DAIN"
End If
'Error handling if no center is selected
If [chk-OCC].Value = Flase Then
If [chk-MTL].Value = Flase Then
If [chk-BCC].Value = Flase Then
If [chk-RTF].Value = Flase Then
If [chk-DAIN].Value = Flase Then
MsgBox "You have not selected a center to search search....please try again."
Me.[chk-allctr].SetFocus
Exit Sub
End If
End If
End If
End If
End If
'end of error handling
'MsgBox "centers used are: Chr(10) " & ctrOCC & " Chr(10) " & ctrBCC & " Chr(10) " & ctrMTL & " Chr(10) " & ctrITS & " Chr(10) " & ctrDAIN & " For this run"
'All good so far, now we will parse the application code if an
'application code report is selected
appl = "*"
If [opt-criteria].Value = 1 Then
'error handling
If IsNull(Me.[sel-appcode]) Then
MsgBox "You have not entered an application code to search....please try again."
Me.[sel-appcode] = Null
Me.[sel-appcode].SetFocus
Exit Sub
End If
'end of error handling
End If
If [opt-criteria].Value = 1 Then
appl = Me![sel-appcode].Value
End If
'trust = "no"
'If Mid(appl, 3, 2) = "RT" Then trust = "yes"
'length = Len(appl)
'If length = 2 Then appltype = "short"
'If length = 3 Then appltype = "long"
'If appltype = "short" Then fullapp = "" & appl & "00"
'If appltype = "long" Then fullapp = "" & appl & "0"
'If trust = "yes" Then fullapp = appl
'End If
fullapp = appl
'MsgBox "App to use is: " & appl & " fullapp code is " & fullapp & "."
'Now we set values if names are used
coor = "*"
cust = "*"
appL3 = "*"
appL4 = "*"
appL5 = "*"
If [opt-criteria].Value = 2 Then
'error handling
If IsNull(Me.[sel-coor]) Then
MsgBox "You have not entered a Coordinator to search....please try again."
Me.[sel-coor] = Null
Me.[sel-coor].SetFocus
Exit Sub
End If
'end of error handling
coor = Me![sel-coor].Value
'MsgBox "Coordinator report selected for: " & coor & "."
End If
If [opt-criteria].Value = 3 Then
'error handling
If IsNull(Me.[sel-custodian]) Then
MsgBox "You have not entered a Custodian to search....please try again."
Me.[sel-custodian] = Null
Me.[sel-custodian].SetFocus
Exit Sub
End If
'end of error handling
cust = Me![sel-custodian].Value
'MsgBox "Custodian report selected for: " & cust & "."
End If
If [opt-criteria].Value = 4 Then
'error handling
If IsNull(Me.[sel-L3]) Then
MsgBox "You have not entered an L3 to search....please try again."
Me.[sel-L3] = Null
Me.[sel-L3].SetFocus
Exit Sub
End If
'end of error handling
appL3 = Me![sel-L3].Value
'MsgBox "L3 report selected for: " & appL3 & "."
End If
If [opt-criteria].Value = 5 Then
'error handling
If IsNull(Me.[sel-L4]) Then
MsgBox "You have not entered an L4 to search....please try again."
Me.[sel-L4] = Null
Me.[sel-L4].SetFocus
Exit Sub
End If
'end of error handling
appL4 = Me![sel-L4].Value
'MsgBox "L4 report selected for: " & appL4 & "."
End If
If [opt-criteria].Value = 6 Then
'error handling
If IsNull(Me.[sel-L5]) Then
MsgBox "You have not entered an L5 to search....please try again."
Me.[sel-L5] = Null
Me.[sel-L5].SetFocus
Exit Sub
End If
'end of error handling
appL5 = Me![sel-L5].Value
'MsgBox "L5 report selected for: " & appL5 & "."
End If
'Most of these reports take a while to build with this macro, so to make sure the user
'knows that the macro is still working, we didsplay a splash screen. It's cute and has
'hamsters, cause everyone loves hamsters.
DoCmd.OpenForm "PlsWaitFrm", acWindowNormal
[Forms]![PlsWaitFrm].Repaint
'All of out criteria values are now selected. We can move on to pulling data from the tables.
'We start by populating the IIPM table with the information that we require for applications.
strSQ1 = "DELETE * from [tbl-RPT-IIPM] "
db.Execute strSQ1
strSQ2 = "INSERT INTO [tbl-RPT-IIPM] " & _
"SELECT * FROM [tbl-IIPM] " & _
"WHERE (([AppCode] like '" & fullapp & "')" & _
"AND ([AppCoordinator] like '" & coor & "') " & _
"AND ([AppCustodian] like '" & cust & "') " & _
"AND ([L3] like '" & appL3 & "') " & _
"AND ([L4] like '" & appL4 & "') " & _
"AND ([L5] like '" & appL5 & "')) "
db.Execute strSQ2
'MsgBox "made it past the populate of rpt-iipm"
'Now we have populated the IIPM report table, it's time to populate the event report table.
'We will loop through all fields in the IIPM report table and pull information for each
'application code.
strSQ3 = "DELETE * from [tbl-EVENTREPORT] "
db.Execute strSQ3
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl-RPT-IIPM") 'this opens the IIPM report table just populated
'populate the table
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
'we will execute these action against the selected record.
'first step - parse the application code to display the full application code
appl = rs![AppCode].Value
length = Len(appl)
If length = 1 Then appl = "" & appl & "00"
rptdelin = Mid(appl, 3, 1)
rptcode = Mid(appl, 1, 3)
If rptdelin = "0" Then rptcode = Mid(appl, 1, 2)
If rptdelin = "R" Then rptcode = "RT" & Mid(appl, 1, 2) & ""
'MsgBox "searching for: " & rptcode & "."
applist = applist & "," & appl
strSQ4 = "INSERT INTO [tbl-EVENTREPORT] " & _
"SELECT * FROM [tbl-EVENT DATA] " & _
"WHERE (([ev-jobname] LIKE '?" & rptcode & "*') " & _
"AND (([ev-ctr] = '" & ctrOCC & "')" & _
"OR ([ev-ctr] = '" & ctrMTL & "')" & _
"OR ([ev-ctr] = '" & ctrBCC & "')" & _
"OR ([ev-ctr] = '" & ctrITS & "')" & _
"OR ([ev-ctr] = '" & ctrDAIN & "'))" & _
"AND (" & kinddate & ") " & _
"AND " & evstatus & ")"
db.Execute strSQ4
'now we're done with this report, we move on to the next
rs.MoveNext 'press Ctrl+G to see debuG window beneath
Loop
'END OF LOOPING CODE
'MsgBox "made it past the looping"
'Now we have completed populating the table that the report will be based on.
'Next step is to gather master statistics to produce abend and success percentages.
totfail = DCount("[ev-status]", "tbl-EVENTREPORT", "[ev-status] = 'AEOJ'")
totsucc = DCount("[ev-status]", "tbl-EVENTREPORT", "[ev-status] = 'EOJ'")
Dim allabend As Long
Dim allsucc As Long
allabend = DCount("[ev-status]", "[tbl-EVENT DATA]", "[ev-status] = 'AEOJ' AND ([ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & ")")
allsucc = DCount("[ev-status]", "[tbl-EVENT DATA]", "[ev-status] = 'EOJ' AND ([ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & ")")
Dim pctabend As Long
Dim pctsucc As Long
pctabend = (totfail / allabend) * 100
pctsucc = (totsucc / allsucc) * 100
'Now we will generate the reports for display based on what type of report was selected
'by the user in the initial form.
'Before we open the report, we will close the splash screen
DoCmd.Close acForm, "PlsWaitFrm", acSaveNo
'Now we open the report
If [opt-criteria].Value = 1 Then
fullappnm = DLookup("AppName", "tbl-RPT-IIPM", "AppCode = '" & fullapp & "' ")
fullappcoor = DLookup("AppCoordinator", "tbl-RPT-IIPM", "AppCode = '" & fullapp & "' ")
DoCmd.OpenReport "rpt-APPLREPORT", acViewReport
[Reports]![rpt-APPLREPORT]![rpt-appcode].Value = fullapp
[Reports]![rpt-APPLREPORT]![rpt-appname].Value = fullappnm
[Reports]![rpt-APPLREPORT]![rpt-appcoor].Value = fullappcoor
[Reports]![rpt-APPLREPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-APPLREPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-APPLREPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-APPLREPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 2 Then
DoCmd.OpenReport "rpt-COORREPORT", acViewReport
[Reports]![rpt-COORREPORT]![rpt-appcode].Value = applist
[Reports]![rpt-COORREPORT]![rpt-appcoor].Value = coor
[Reports]![rpt-COORREPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-COORREPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-COORREPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-COORREPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 3 Then
DoCmd.OpenReport "rpt-CUSTREPORT", acViewReport
[Reports]![rpt-CUSTREPORT]![rpt-appcode].Value = applist
[Reports]![rpt-CUSTREPORT]![rpt-appcoor].Value = cust
[Reports]![rpt-CUSTREPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-CUSTREPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-CUSTREPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-CUSTREPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 4 Then
DoCmd.OpenReport "rpt-L3REPORT", acViewReport
[Reports]![rpt-L3REPORT]![rpt-appcode].Value = applist
[Reports]![rpt-L3REPORT]![rpt-appcoor].Value = appL3
[Reports]![rpt-L3REPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-L3REPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-L3REPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-L3REPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 5 Then
DoCmd.OpenReport "rpt-L4REPORT", acViewReport
[Reports]![rpt-L4REPORT]![rpt-appcode].Value = applist
[Reports]![rpt-L4REPORT]![rpt-appcoor].Value = appL4
[Reports]![rpt-L4REPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-L4REPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-L4REPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-L4REPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 6 Then
DoCmd.OpenReport "rpt-L5REPORT", acViewReport
[Reports]![rpt-L5REPORT]![rpt-appcode].Value = applist
[Reports]![rpt-L5REPORT]![rpt-appcoor].Value = appL5
[Reports]![rpt-L5REPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-L5REPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-L5REPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-L5REPORT]![rpt-succpct].Value = pctsucc
End If
ErrorHandler:
If Err.Number = 7874 Then
Resume Next 'Tried to delete a non-existing table, resume
End If
End Sub
'''
首先，您需要找出瓶颈所在，因此我建议在整个代码中放置一些 Debug.Print Now 语句，让您了解导致问题的原因。
我猜想花费大部分时间的两个过程是您正在执行的 DELETE/INSERT 语句。
我建议您不要这样做，而是考虑规范化您的数据库，然后创建一个查询来提供您需要的信息。
此外，通过 运行 直接从查询而不是临时报告 table 意味着您不必担心 deletes/inserts 造成数据库膨胀。
如果你真的坚持要保留这个过程，那么考虑删除table [tbl-RPT-IIPM] 然后重新创建它，而不是删除记录。并考虑在插入之前删除索引，然后再将它们添加回来，因为索引会减慢插入速度，但显然会加快搜索和连接速度。
此外，当您向 [tbl-RPT-IIPM] 中插入数据时，您使用的是 ([L3] like '" & appL3 & "')，这与 ([L3]='" & appL3 & "') 相同，但速度较慢。
当您向 [tbl-EVENTREPORT] 中插入数据时，您是在遍历记录集时执行此操作 - 使用 INSERT SQL 语句可能更快。
此致，
Applecore，首先感谢您的见解。不幸的是，由于数据处理方式的性质，我不确定其中一些是否可以实现。我使用 debug.print 语句来更好地了解时间。
你说得对，INSERT 语句给我带来的问题最多，而且仅次于此。删除几乎立即飞过，没有问题。它是事件数据中的第二个插入，这会减慢它的速度。
从一开始我就一直在思考如何更有效地恋爱并建立更好的关系，但我受阻了。我的问题是，事件 table 和事件 table 之间的数据是相关的 "in the world" 但在数据方面没有明确的方式。没有复杂的计算就无法确定关系。例如，应用程序数据的唯一部分是应用程序代码。他们总是独一无二的。单个应用程序协调器可以分配给它们许多代码，保管人、L3、L4 等也可以。每个事件都与一个应用程序相关，但是，没有导出的特定字段告诉应用程序代码，它是获得的通过解析事件名称（是的，这听起来很陈旧）。事件命名标准是标准的大型机 8 字符名称： . 例如 PGRD1234 - 生产作业，GRD 应用程序，1234 作为指示符。因此，为了确定该工作与哪个应用程序相关，我采用了应用程序代码，并使用通配符 select LIKE。我很清楚这不是 100% 准确，但要使用通配符，我似乎无法使用 LIKE。我无法使“=”与通配符一起工作。你是否可以？
您还提到了 "When you are inserting data into [tbl-EVENTREPORT], you are doing it when looping through a recordset - it may be faster to use an INSERT SQL statement."，我不确定您在说什么。抱歉。我不认为我理解它。我想这就是我现在正在做的。我使用 IIPM table 获取我需要提取的应用程序代码列表，然后遍历该记录集以仅提取那些应用程序的所有事件数据。由于数据之间没有直接关联，我想不出另一种方法来做到这一点。
好的，有了更多的信息，更多的答案可能（也可能不会！！）有帮助。同样，您将需要 运行 计时测试以查看哪种最适合您。
尝试将 "Yes/No" 字段添加到 table [tbl-EVENT DATA]。然后，您可以使用 UPDATE 语句来指示要在报告中包含哪些字段，而不是使用缓慢的 INSERT 查询。
另一种尝试是将 INSERT 语句替换为多个语句，每个语句使用 [ev-ctr] 的不同值。或者不要使用 OR 尝试使用 IN:
strSQ4 = "INSERT INTO [tbl-EVENTREPORT] " & _
"SELECT * FROM [tbl-EVENT DATA] " & _
"WHERE [ev-jobname] LIKE '?" & rptcode & "*' " & _
"AND [ev-ctr] IN('" & ctrOCC & "','" & ctrMTL & "','" & ctrBCC & "','" & ctrITS & "','" & ctrDAIN & "')" & _
"AND " & kinddate & _
"AND " & evstatus
此外，我注意到 kinddate 设置为在一个实例中有效地包含所有日期，而 evstatus 设置为同时包含 "EOJ" 和 "AEOJ"一个实例。在这些情况下，与其将这些字段作为条件包括在内，您可能希望完全不包括它们：
If state = 1 Then
evstatus = " AND [ev-status] = 'AEOJ'"
ElseIf state = 2 Then
evstatus = " AND [ev-status] = 'EOJ'"
ElseIf state = 3 Then
evstatus = " "
End If
然后在 SQL 语句中将 " AND " & evstatus 重写为 & evstatus。
最后要看的是实际上直接在后端 运行 INSERT，而不是在前端对链接的 table 进行操作，因为 Access 会拖通过网络传输大量数据，然后将其发回。作为基本指南，如下所示：
Sub sUpdateQuery()
Dim objAccess As New Access.Application
objAccess.OpenCurrentDatabase "J:\downloads\test.accdb"
objAccess.DoCmd.RunSQL "UPDATE test2 SET Field1=UCASE(Field1);"
objAccess.CloseCurrentDatabase
Set objAccess = Nothing
End Sub
此致，