MS Access: Comparing Queries Between Two Databases (a query diff)

Often, when you have MS Access in a small office, and have done the right thing and split the database into a backend of tables and frontend of queries, reports, and forms, you end up with changes to the objects in multiple files. The trickiest is comparing queries, because the query object is modified if even a column width is changed. You need to dig deeper and compare queries.

This code below compares the local queries to queries in another database.

In order to use it, you need to link the remote MSysObjects table. Call it MSysObjects-REMOTE-mdb. That’s because we get lists of queries by dumping them from the hidden MSysObjects table rather than via the APIs. This way, we get all the queries.

You also need to create a table tblMultiMDBQueryComparison with the following fields: DBName text, ObjName text, ModDate datetime. We dump the query object info into this table first, then generate a temporary report from it.

Normally, I wouldn’t post code that, imnsho, is so crappy, but there were a number of people online requesting a tool that does this, or something similar, like comparing object modification dates.

Part of the reason it’s so screwed up looking is that it uses both DAO and ADO. It’s cut-and-pasted from the www and my past work.

What’s interesting is that DAO will always return the SQL for a query, but ADO will not. ADO doesn’t return queries (called commands) when the underlying SQL contains a bug. “This isn’t a bug, it’s a feature.” You could hack this to point the “remote” db back to the local db, and find all the buggy queries.

Sub DiffQueries()
    ' http://support.microsoft.com/kb/...
    ' http://www.everythingaccess.com/...
    ' http://msdn.microsoft.com/en-us/...
    ' http://msdn.microsoft.com/en-us/...
    ' http://oreilly.com/catalog/proga...
    ' http://www.vb-helper.com/howto_a...
    
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim qdf As DAO.QueryDef
    Dim q As DAO.QueryDef
    Dim cn As ADODB.Connection
    Dim rstNames As ADODB.Recordset
    Dim localdb As ADODB.Connection
    Dim remote As ADODB.Connection
    Dim cat As ADOX.Catalog
    Dim v As ADOX.View
    Dim cmd As ADODB.Command
    
    ' Use this as a model for dumping objects into the table.
    s = "INSERT INTO tblMultiMDBQueryComparison ( DBName, ObjName, ModDate ) " & _
     "SELECT 'LOCAL' AS DBName, MSysObjects.Name AS ObjName, MSysObjects.DateUpdate " & _
     "FROM MSysObjects WHERE ((MSysObjects.Type)=5) "
    
    Set db = CurrentDb
        
    ' Load the local objects
    db.Execute ("DELETE FROM tblMultiMDBQueryComparison")
    db.Execute s

    s = "INSERT INTO tblMultiMDBQueryComparison ( DBName, ObjName, ModDate ) " & _
     "SELECT 'mdb' AS DBName, MSysObjects.Name AS ObjName, MSysObjects.DateUpdate " & _
     "FROM `MSysObjects-REMOTE-mdb` as MSysObjects WHERE ((MSysObjects.Type)=5)"
    db.Execute s
    
    db.Execute "DELETE FROM tblMultiMDBQueryComparison WHERE ObjName LIKE '~*'"
    
    ' Create a table of object names.
    On Error Resume Next
    db.Execute "drop table tmpMultiMDBQueryComparison"
    
    db.Execute "create table tmpMultiMDBQueryComparison " & _
     "(ObjName text, LOCAL datetime, LOCALQuery memo, mdb datetime, mdbQuery memo, Newest text)"

    ' just in case the drop fails, and the table exists
    db.Execute "DELETE FROM tmpMultiMDBQueryComparison"

    s = "INSERT INTO tmpMultiMDBQueryComparison (ObjName) SELECT DISTINCT ObjName FROM tblMultiMDBQueryComparison"
    db.Execute s
    
    Set cat = New ADOX.Catalog

    Set localdb = CurrentProject.Connection ' Connect to current database.

    On Error GoTo AdoError
   
    Set remote = New ADODB.Connection
    
    remote.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                     "Data Source=C:PATHDATA.mdb;"
    remote.Open
    
    Set cat.ActiveConnection = remote
    
    Set rst = db.OpenRecordset("tmpMultiMDBQueryComparison", dbOpenTable)
    
    On Error GoTo 0

    rst.MoveFirst
    While (Not rst.EOF)
        qName = rst.Fields("ObjName")
        For Each q In CurrentDb.QueryDefs
            If q.name = qName Then
                rst.Edit
                rst.Fields("LOCALQuery").Value = q.sql
                rst.Fields("LOCAL").Value = q.LastUpdated
                rst.Update
            End If
        Next

        For Each v In cat.Views
            If v.name = qName Then
                Set cmd = v.Command
                rst.Edit
                rst.Fields("mdbQuery").Value = cmd.CommandText
                rst.Fields("mdb").Value = v.DateModified
                rst.Update
            End If
        Next
        rst.MoveNext
    Wend
    Exit Sub

AdoError:
       i = 1
       On Error Resume Next

       ' Enumerate Errors collection and display properties of
       ' each Error object (if Errors Collection is filled out)
       Set Errs1 = remote.Errors
       For Each errLoop In Errs1
        With errLoop
           strTmp = strTmp & vbCrLf & "ADO Error # " & i & ":"
           strTmp = strTmp & vbCrLf & "   ADO Error   # " & .Number
           strTmp = strTmp & vbCrLf & "   Description   " & .Description
           strTmp = strTmp & vbCrLf & "   Source        " & .Source
           i = i + 1
        End With
       Next

AdoErrorLite:
       ' Get VB Error Object's information
       strTmp = strTmp & vbCrLf & "VB Error # " & Str(Err.Number)
       strTmp = strTmp & vbCrLf & "   Generated by " & Err.Source
       strTmp = strTmp & vbCrLf & "   Description  " & Err.Description

       MsgBox strTmp

       ' Clean up gracefully without risking infinite loop in error handler
       On Error GoTo 0
       
End Sub