我得到了一个 Access 数据库,其中包括 12 个数据表,每个表包含大约 200,000 行。这些表格中的每一个都包含大约 200 座建筑物的月度数据。我不想花很多时间规范化数据库,我只是编写了一个快速脚本来根据这些数据为每个建筑物创建一个表。
说了这么多,我的代码运行大约需要 1.5 小时。我可以做些什么来加快速度,还是我只是达到了 Access 的极限?任何建议将不胜感激。
Sub RunQueryForEachBuilding()
Dim RRRdb As DAO.Database
Dim rstBuildNames As DAO.Recordset
Dim rstDataTables As DAO.Recordset
Dim rstMonthlyData As DAO.Recordset
Dim strSQL As String
Dim sqlCreateT As String
Dim sqlBuildData As String
Dim strDataTable As String
Dim sqlDrop As String
On Error GoTo ErrorHandler
'open recordsets for building names and datatables
Set RRRdb = CurrentDb
Set rstBuildNames = RRRdb.OpenRecordset("BuildingNames")
Set rstDataTables = RRRdb.OpenRecordset("DataTables")
Do Until rstBuildNames.EOF
' Create a table for each building.
' Check if table exists, if it does delete and recreate.
If Not IsNull(DLookup("Name", "MSysObjects", "Name='" & rstBuildNames.Fields("BuildingPath") & "'")) Then
' Table Exists - delete existing
sqlDrop = "DROP TABLE [" & rstBuildNames.Fields("BuildingPath") & "]"
RRRdb.Execute sqlDrop
' re-create blank table
End If
'create table for this building
sqlCreateT = "CREATE TABLE [" & rstBuildNames.Fields("BuildingPath") & _
"] (BuildingPath VARCHAR, [TimeStamp] DATETIME, CHWmmBTU DOUBLE , ElectricmmBTU DOUBLE, kW DOUBLE, kWSolar DOUBLE, kWh DOUBLE, kWhSolar DOUBLE)"
RRRdb.Execute sqlCreateT
'populate data from monthly table into the building name table.
Do While Not rstDataTables.EOF
' get data from each monthly table for this building and APPEND to table.
strDataTable = rstDataTables.Fields("[Data Table]")
'Debug.Print strDataTable
'create a SQL string that only selects records that are for the correct building & inserts them into the building table
sqlBuildData = "INSERT INTO [" & rstBuildNames.Fields("BuildingPath")
sqlBuildData = sqlBuildData & "] ([TimeStamp], [CHWmmBTU], [ElectricmmBTU], kW, [kWSolar], kWh, [kWhSolar], BuildingPath) "
sqlBuildData = sqlBuildData & " SELECT [TimeStamp], [CHW mmBTU], [Electric mmBTU], kW, [kW Solar], kWh, [kWh Solar], BuildingPath FROM "
sqlBuildData = sqlBuildData & rstDataTables.Fields("[Data Table]") & " WHERE BuildingPath LIKE '*" & rstBuildNames.Fields("BuildingPath") & "'"
'Debug.Print sqlBuildData
RRRdb.Execute sqlBuildData
rstDataTables.MoveNext
Loop
rstBuildNames.MoveNext
rstDataTables.MoveFirst
Loop
Set rstBuildNames = Nothing
Set rstDataTables = Nothing
ErrorHandler:
'MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Sub