centralmike
asked on
I need to compare one access table to another to show missing columns and output columns to a table.
I need to know if it possible to loop through a recordset(tblViewNames) comparing one table to another. I need to be able to output column that don't exist in the BI View tables from the CR tables . I have a sample query created in Teradata where it shows BI columns missing from the CR Tables comparison. Then I need to output this missing columns to a table(tblFinalOutput).
td_example.xlsx
Edge_Ticket.accdb
td_example.xlsx
Edge_Ticket.accdb
I don't think it is doable with a query, as it will require to query the system tables, wich hold obscure (and undocumented) data.
But with VBA, you can obtain a tabledef object wich represent a table, and loop trough its fields collection.
Sample code for Excel:
But with VBA, you can obtain a tabledef object wich represent a table, and loop trough its fields collection.
Sample code for Excel:
Public Sub test()
Const acQuitSaveNone As Byte = 2
Dim app As Object '// Access.Application
Set app = CreateObject("Access.Application")
Dim db As Object '// DAO.Database
Set db = app.DBEngine.Workspaces(0).OpenDatabase(ThisWorkbook.Path & "\Edge_Ticket.accdb")
Dim columnList As Collection
Set columnList = GetMissingColumns(db.TableDefs("MA_P_MDM_BI_VW_V_POLICY_DIM"), db.TableDefs("MA_P_MDM_CR_VW_V_POLICY"))
db.Close
app.Quit acQuitSaveNone
'// Do whatever you want with the collection here
End Sub
'// Private Function GetMissingColumns(ByRef left As DAO.TableDef, ByRef right As DAO.TableDef) As Collection
Private Function GetMissingColumns(ByRef left As Object, ByRef right As Object) As Collection
Dim columnList As Collection
Set columnList = New Collection
Dim field As Object '// DAO.field
For Each field In right.Fields
If Not (ExistInCollection(field.Name, left.Fields)) Then
columnList.Add field.Name
End If
Next
Set GetMissingColumns = columnList
End Function
Private Function ExistInCollection(ByVal key As String, ByRef col As Object) As Boolean
ExistInCollection = ExistInCollectionByVal(key, col) Or ExistInCollectionByRef(key, col)
End Function
Private Function ExistInCollectionByVal(ByVal key As String, ByRef col As Object)
On Error GoTo Error
Dim item As Variant
item = col(key)
ExistInCollectionByVal = True
Exit Function
Error:
ExistInCollectionByVal = False
End Function
Private Function ExistInCollectionByRef(ByVal key As String, ByRef col As Object)
On Error GoTo Error
Dim item As Variant
Set item = col(key)
ExistInCollectionByRef = True
Exit Function
Error:
ExistInCollectionByRef = False
End Function
ASKER
Gustav - Is there a way to loop through the re
ASKER
Gustav is there way to loop through the recordset, so you don't have to do one table at a time?
Recordset is an object that hold data from a data source (a table or a query), it doesn't hold table names.
With teh code provided by Gustav, and by me, you need to provide the table names you want to compare, as we have no way to deduce it.
With teh code provided by Gustav, and by me, you need to provide the table names you want to compare, as we have no way to deduce it.
Yes, you can expand my Test function to loop the table names:
Edge_Ticket_2.accdb
Public Sub Test()
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim Source As String
Dim Target As String
Set db = CurrentDb
For Each td In db.TableDefs
Source = td.Name
If Left(Source, 3) = "MA_" Then
If InStr(1, Source, "_BI_", vbTextCompare) > 0 Then
' Chop off "_DIM".
Target = Left(Replace(Source, "_BI_", "_CR_"), Len(Source) - 4)
Debug.Print Source, Target
InsertMissingFields Source, Target
End If
End If
Next
End Sub
See the attached demo, please.Edge_Ticket_2.accdb
ASKER
Gustav, I think you are pretty close. I didn't want to incorrectly change the logic. But it's comparing BI layer to the CR layer. It should be comparing the CR to the BI. The first test module work correctly. When you added the logic to loop through the recordset the BI and CR layers somehow got reversed.
First set of code the worked correctly. Second set reversed the comparison.
CALL TEST()
MA_P_MDM_CR_VW_V_POLICY POLICY_ROW_SEQ_ID
MA_P_MDM_CR_VW_V_POLICY APP_SIGNED_REGION_VALUE_CD E
MA_P_MDM_CR_VW_V_POLICY APP_ENTRY_OPERATOR_ID
MA_P_MDM_CR_VW_V_POLICY APP_SUBMISSION_METHOD_CDE
MA_P_MDM_CR_VW_V_POLICY APP_SOURCE_SYSTEM_CDE
MA_P_MDM_CR_VW_V_POLICY APP_FORM_NME
MA_P_MDM_CR_VW_V_POLICY LINE_OF_BUSINESS_CATEGORY_ ID
MA_P_MDM_CR_VW_V_POLICY ETL_STAGE_TAG_ID
MA_P_MDM_CR_VW_V_POLICY UNIQUE_ROW_ID
First set of code the worked correctly. Second set reversed the comparison.
CALL TEST()
MA_P_MDM_CR_VW_V_POLICY POLICY_ROW_SEQ_ID
MA_P_MDM_CR_VW_V_POLICY APP_SIGNED_REGION_VALUE_CD
MA_P_MDM_CR_VW_V_POLICY APP_ENTRY_OPERATOR_ID
MA_P_MDM_CR_VW_V_POLICY APP_SUBMISSION_METHOD_CDE
MA_P_MDM_CR_VW_V_POLICY APP_SOURCE_SYSTEM_CDE
MA_P_MDM_CR_VW_V_POLICY APP_FORM_NME
MA_P_MDM_CR_VW_V_POLICY LINE_OF_BUSINESS_CATEGORY_
MA_P_MDM_CR_VW_V_POLICY ETL_STAGE_TAG_ID
MA_P_MDM_CR_VW_V_POLICY UNIQUE_ROW_ID
Then it probably is:
Edge_Ticket_2.accdb
Public Sub Test2()
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim Source As String
Dim Target As String
Set db = CurrentDb
For Each td In db.TableDefs
Source = td.Name
If Left(Source, 3) = "MA_" Then
If InStr(1, Source, "_CR_", vbTextCompare) > 0 Then
' Append "_DIM".
Target = Replace(Source, "_CR_", "_BI_") & "_DIM"
Debug.Print Source, Target
InsertMissingFields Source, Target
End If
End If
Next
End Sub
See the attached, please.Edge_Ticket_2.accdb
ASKER
Gustav, I added couple more tables to the database and seems to have broken the logic. Instead of looping through the table def collections of the database. Would the logic work if you looping through a recordset "tblViewnames". Hopefully this question makes a little more sense. If you run test module 4. You will see the results in tblFinalOutput. The code seems to skip several tables.
Edge_Ticket_exp.accdb
Edge_Ticket_exp.accdb
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Gustav, Sorry for misunderstanding. I see your just calling the function in a query.
ASKER
Thank you very Gustav I have better understanding of access objects.
You are welcome!
Open in new window
Run the Test in the attached demo.Edge_Ticket.accdb