brl8
brl8

Reputation: 646

Access 2007 VBA - large dataset - how to optimize this query/code?

I've been given an Access database which includes 12 tables of data that each contain around 200,000 rows. Each of these tables contain monthly data on about 200 buildings. I don't want to spend a lot of time normalizing the database, I just wrote a quick script to create a table for each building from this data.

Having said all that, my code is taking about 1.5 hours to run. Is there anything I can do to speed this up, or am I just reaching the limits of what Access is capable of? Any suggestions will be appreciated.

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

Upvotes: 1

Views: 487

Answers (1)

HansUp
HansUp

Reputation: 97101

That code drops and then re-creates rstBuildNames.Fields("BuildingPath") with the same structure. It should be faster to just empty out the table:

"DELETE FROM " & rstBuildNames.Fields("BuildingPath")

However that is not likely to speed up the operation enough.

The WHERE clause of the INSERT query forces a full table scan ...

" WHERE BuildingPath LIKE '*" & rstBuildNames.Fields("BuildingPath") & "'"

If you can use an exact string match instead of a Like comparison, and create an index on BuildingPath, you should see a significant improvement.

" WHERE BuildingPath = '" & rstBuildNames.Fields("BuildingPath") & "'"

I will suggest dbOpenSnapshot, too, even though it won't make a noticeable difference since you're only opening the recordsets one time. (It may not help, but it won't hurt.)

Set rstBuildNames = RRRdb.OpenRecordset("BuildingNames", dbOpenSnapshot)
Set rstDataTables = RRRdb.OpenRecordset("DataTables", dbOpenSnapshot)

Upvotes: 1

Related Questions