comparing Queries / Fields in 2 databases

W

William Benson

Hello folks,

I wrote a procedure for comparing queries in 2 different databases (part of
a version control strategy) and *thought* it would be a slam dunk to test
the queries in DB1 for existence in DB2, and of those which existed, test
that they both had the same field names. Apparently the line below

For Each
F1 In Q1.Fields

is not working out. Any idea why? Thanks if so...



Sub CompareDB()
Dim WS As Workspace
Dim DB1 As Database
Dim DB2 As Database
Dim Q1 As QueryDef
Dim Q2 As QueryDef
Dim F1 As Field
Dim F2 As Field
Dim FldFound As Boolean
Dim QFound As Boolean
Dim Msg As String


' Create a new Microsoft Jet workspace.
Set WS = CreateWorkspace("NewJetWorkspace", "admin", "", dbUseJet)

Const DB1_Path As String = "c:\DB1.mdb"
Const DB2_Path As String = "c:\DB2.mdb"

Set DB1 = WS.OpenDatabase(DB1_Path)
Set DB2 = WS.OpenDatabase(DB2_Path)

For Each Q1 In DB1.QueryDefs
QFound = False
For Each Q2 In DB2.QueryDefs
If Q1.Name = Q2.Name Then
QFound = True
If Q2.Fields.Count <> Q1.Fields.Count Then
Msg = Msg & " | " & "FIELD COUNT differs"
End If
For Each F1 In Q1.Fields
FldFound = False
For Each F2 In Q2.Fields
If F1.Name = F2.Name Then
FldFound = True
Exit For
End If
Next F2
If Not FldFound Then
If InStr(Msg, " " & Q1.Name & " ") = 0 Then
Msg = Msg & " | " & Q1.Name & " "
End If
Msg = Msg & " | " & "FIELD " & F1.Name & " NOT FOUND"
End If
Next F1
Exit For
End If
Next Q2
If Not QFound Then
Msg = Msg & " | QUERY " & Q1.Name & " NOT FOUND"
End If
Next Q1
If Msg <> "" Then Msgbox Msg
End Sub
 
J

John Griffiths

Used DAO. to ensure all of same type - Works OK John

Note Queries that only exist in db2 are not resolved, ok if db2 is a version
to be updated
but if two developers are using separate db and then merging their different
possibly
non resolvable changes you have more work to do

John
'-----------------------------------------------------
Sub CompareDB()

Dim WS As DAO.Workspace
Dim DB1 As DAO.Database
Dim DB2 As DAO.Database

Dim Q1 As DAO.QueryDef
Dim Q2 As DAO.QueryDef

Dim F1 As DAO.Field
Dim F2 As DAO.Field

Dim Msg As String


' Create a new Microsoft Jet workspace.
Set WS = CreateWorkspace("NewJetWorkspace", "admin", "", dbUseJet)

Const DB1_Path As String = "c:\DB1.mdb"
Const DB2_Path As String = "c:\DB2.mdb"

Set DB1 = WS.OpenDatabase(DB1_Path)
Set DB2 = WS.OpenDatabase(DB2_Path)

For Each Q1 In DB1.QueryDefs
If Not CompareQuery(Q1, DB2, Q2) Then
Msg = Msg & " | QUERY " & Q1.Name & " NOT FOUND"
Else
If Q1.Fields.Count <> Q2.Fields.Count Then
Msg = Msg & " | " & "FIELD COUNT DIFFERS"
End If

For Each F1 In Q1.Fields
If Not CompareFields(F1, Q2, F2) Then
Msg = Msg & " | " & "FIELD [" & Q1.Name & "].[" & F1.Name &
"] NOT FOUND"
ElseIf F1.Type <> F2.Type Then
Msg = Msg & " | " & "FIELD [" & Q1.Name & "].[" & F1.Name &
"] Type DIFFERS"
End If

Next 'F1

End If
Next Q1

If Msg <> "" Then MsgBox Msg

End Sub

'-----------------------------------------------------
Private Function CompareQuery(InQuery As DAO.QueryDef, InDB As DAO.Database,
InOutQuery As DAO.QueryDef) As Boolean
On Error GoTo Err_Handler
CompareQuery = False

Set InOutQuery = InDB.QueryDefs(InQuery.Name)

CompareQuery = True

Exit Function
Err_Handler:

End Function

'-----------------------------------------------------
Private Function CompareFields(InField As DAO.Field, InQuery As
DAO.QueryDef, InOutField As DAO.Field) As Boolean
On Error GoTo Err_Handler
CompareFields = False

Set InOutField = InQuery.Fields(InField.Name)

CompareFields = True

Exit Function
Err_Handler:

End Function

'-----------------------------------------------------
 
W

William Benson

John, sorry, I posted the same message in microsoft.public.access, thinking
here was the wrong place. Dirk Goldgar answered that the queries I was not
getting info on were likely action queries -- which they were. So the code
was basically sound, although incomplete, as you point out.
Thanks, will try to not let dual post happen again.

Bill Benson



John Griffiths said:
Used DAO. to ensure all of same type - Works OK John

Note Queries that only exist in db2 are not resolved, ok if db2 is a
version
to be updated
but if two developers are using separate db and then merging their
different
possibly
non resolvable changes you have more work to do

John
'-----------------------------------------------------
Sub CompareDB()

Dim WS As DAO.Workspace
Dim DB1 As DAO.Database
Dim DB2 As DAO.Database

Dim Q1 As DAO.QueryDef
Dim Q2 As DAO.QueryDef

Dim F1 As DAO.Field
Dim F2 As DAO.Field

Dim Msg As String


' Create a new Microsoft Jet workspace.
Set WS = CreateWorkspace("NewJetWorkspace", "admin", "", dbUseJet)

Const DB1_Path As String = "c:\DB1.mdb"
Const DB2_Path As String = "c:\DB2.mdb"

Set DB1 = WS.OpenDatabase(DB1_Path)
Set DB2 = WS.OpenDatabase(DB2_Path)

For Each Q1 In DB1.QueryDefs
If Not CompareQuery(Q1, DB2, Q2) Then
Msg = Msg & " | QUERY " & Q1.Name & " NOT FOUND"
Else
If Q1.Fields.Count <> Q2.Fields.Count Then
Msg = Msg & " | " & "FIELD COUNT DIFFERS"
End If

For Each F1 In Q1.Fields
If Not CompareFields(F1, Q2, F2) Then
Msg = Msg & " | " & "FIELD [" & Q1.Name & "].[" & F1.Name &
"] NOT FOUND"
ElseIf F1.Type <> F2.Type Then
Msg = Msg & " | " & "FIELD [" & Q1.Name & "].[" & F1.Name &
"] Type DIFFERS"
End If

Next 'F1

End If
Next Q1

If Msg <> "" Then MsgBox Msg

End Sub

'-----------------------------------------------------
Private Function CompareQuery(InQuery As DAO.QueryDef, InDB As
DAO.Database,
InOutQuery As DAO.QueryDef) As Boolean
On Error GoTo Err_Handler
CompareQuery = False

Set InOutQuery = InDB.QueryDefs(InQuery.Name)

CompareQuery = True

Exit Function
Err_Handler:

End Function

'-----------------------------------------------------
Private Function CompareFields(InField As DAO.Field, InQuery As
DAO.QueryDef, InOutField As DAO.Field) As Boolean
On Error GoTo Err_Handler
CompareFields = False

Set InOutField = InQuery.Fields(InField.Name)

CompareFields = True

Exit Function
Err_Handler:

End Function

'-----------------------------------------------------

William Benson said:
Hello folks,

I wrote a procedure for comparing queries in 2 different databases (part of
a version control strategy) and *thought* it would be a slam dunk to test
the queries in DB1 for existence in DB2, and of those which existed, test
that they both had the same field names. Apparently the line below

For Each
F1 In Q1.Fields

is not working out. Any idea why? Thanks if so...



Sub CompareDB()
Dim WS As Workspace
Dim DB1 As Database
Dim DB2 As Database
Dim Q1 As QueryDef
Dim Q2 As QueryDef
Dim F1 As Field
Dim F2 As Field
Dim FldFound As Boolean
Dim QFound As Boolean
Dim Msg As String


' Create a new Microsoft Jet workspace.
Set WS = CreateWorkspace("NewJetWorkspace", "admin", "", dbUseJet)

Const DB1_Path As String = "c:\DB1.mdb"
Const DB2_Path As String = "c:\DB2.mdb"

Set DB1 = WS.OpenDatabase(DB1_Path)
Set DB2 = WS.OpenDatabase(DB2_Path)

For Each Q1 In DB1.QueryDefs
QFound = False
For Each Q2 In DB2.QueryDefs
If Q1.Name = Q2.Name Then
QFound = True
If Q2.Fields.Count <> Q1.Fields.Count Then
Msg = Msg & " | " & "FIELD COUNT differs"
End If
For Each F1 In Q1.Fields
FldFound = False
For Each F2 In Q2.Fields
If F1.Name = F2.Name Then
FldFound = True
Exit For
End If
Next F2
If Not FldFound Then
If InStr(Msg, " " & Q1.Name & " ") = 0 Then
Msg = Msg & " | " & Q1.Name & " "
End If
Msg = Msg & " | " & "FIELD " & F1.Name & " NOT FOUND"
End If
Next F1
Exit For
End If
Next Q2
If Not QFound Then
Msg = Msg & " | QUERY " & Q1.Name & " NOT FOUND"
End If
Next Q1
If Msg <> "" Then Msgbox Msg
End Sub
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

comparing query properties in two databases 6
Writing to a table using ado 4
Help with WHERE filter on opening report from dialog 4
Keep form open until loop completes 2
TRICKY ROADBLOCK: multi-user/linked table report issue 1
Blank fields when adding new record to combo box 7
Need help in printing vba code 0
Using SQL statement to append a recordset to a table 5

Top