加速Access数据库

Question

我有一个Access数据库来报告从大型机系统收集的事件统计数据。大型机调度器(ZEKE)没有健壮的报告功能，因此我导出每日事件数据以进行报告。

来自单独源的主列表(不会定期更改的静态列表)列出了各个应用程序，包括应用程序代码(这是生产运行的命名标准)以及该应用程序的程序员、协调员、经理、业务单位等的名称。

用户可以通过任何字段、应用程序代码、程序员、协调器等进行搜索。

选择要搜索的生产中心(有5)或默认为“全部”，并选择“所有日期”、“单个日期”或“日期范围”。

查询接受搜索参数，并以应用程序代码或人员开始搜索应用程序，并将记录复制到临时表进行报告。

例如，要查看应用程序协调器John在过去一周对他负责的所有应用程序有多少次失败，查询将将所有将John作为协调器的应用程序记录移到临时表中。

从那里，它将遍历每个应用程序的临时表，并在该应用程序代码下搜索事件数据，这些事件符合输入的日期、生产中心和事件类型(成功、失败或两者兼而有之)的标准。

这将被移动到最后报告的临时表中。

事件数据表目前为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
'''

Answer 1

好的，如果有更多的信息，更多的答案可能(或者不！)帮助。再次，您将需要运行计时测试，以确定哪一个最适合您。

尝试将“是/否”字段添加到表[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，而不是在前端的链接表上操作，因为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

致以敬意，

Answer 2

首先，您需要找出瓶颈所在，所以我建议在代码中放置一些Debug.Print Now语句，让您了解造成问题的原因。

我猜想大部分时间花费的两个进程是您正在执行的DELETE/INSERT语句。

我建议您不要这样做，而是将数据库规范化，然后创建一个提供所需信息的查询。

此外，通过直接从查询而不是临时表运行报表，意味着不必担心删除/插入会导致数据库膨胀。

如果您确实坚持要保留这个过程，那么考虑删除表[tbl-RPT-IIPM]，然后重新创建它，而不是删除记录。并考虑在insert之前删除索引，然后将它们添加回insert，因为索引会减少插入，但显然会加快搜索和联接。

另外，当您将数据插入到[tbl-RPT-IIPM]中时，您使用的是与([L3]='" & appL3 & "')相同但速度较慢的([L3] like '" & appL3 & "')。

当您将数据插入到[tbl-EVENTREPORT]中时，当循环遍历记录集时--使用INSERT SQL语句可能会更快。

致以敬意，

Answer 3

阿普科雷，首先，让我感谢你的见解。不幸的是，由于数据处理方式的性质，有些数据我不确定我能否实现。我使用了debug.print语句来更好地了解时间。

您是对的，INSERT语句给我带来的问题最多，只有第二个问题。删除的内容几乎立即通过，没有任何问题。这是事件数据的第二个插入，减慢了它的速度。

从一开始，我就一直在思考如何更有效地改善人际关系，但我已经陷入了困境。我的问题是，事件表和事件表之间的数据“在世界上”是相关的，但在数据方面却没有明确的方式。如果没有复杂的计算，就无法确定这种关系。例如，应用程序数据的唯一部分是应用程序代码。它们总是独一无二的。一个应用程序协调器可以有数十个代码分配给它们，保管人、L3、L4等也可以。每个事件都与应用程序相关，然而，没有特定的字段被导出来告诉应用程序代码，它是通过解析事件名来获得的(是的，它听起来很陈旧)。事件命名标准是标准的大型机8字元名称：。例如，PGRD1234 -生产作业，GRD应用程序，1234作为代号.因此，要确定该作业与哪个应用程序相关，我接受应用程序代码，并使用通配符选择LIKE。这不是100%的准确性，我很清楚，但使用通配符，我似乎被困在使用喜欢。我还没能用通配符来工作。你能?

您还提到“当您在中插入数据时，在循环遍历记录集时会这样做--使用INSERT SQL语句可能会更快。”我不知道你在说什么..。我很抱歉。我想我不明白这一点。我想这就是我现在要做的。我使用IIPM表获取我需要提取的应用程序代码的列表，然后循环遍历该记录集，只提取那些应用程序的所有事件数据。由于数据之间没有直接的关联，我想不出另一种方法。