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:\PATH\DATA.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