Solved

VBA to compare two SQL Server Database table structure

Posted on 2009-05-07
5
675 Views
Last Modified: 2013-11-27
I'm looking for some VBA code that would compare two databases on SQL Server 2005.  I want to find all the fields that I need to add to the production database to make it equal my development database.  In other words, I want it to find all the new tables, fields, and changes of datatypes, etc. that I need to put into the production database before releasing it.  This changes are in my development db.
0
Comment
Question by:schmir1
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
5 Comments
 
LVL 16

Assisted Solution

by:Chuck Wood
Chuck Wood earned 100 total points
ID: 24331105
I use this module (basDocumentDatabase) to get all of the objects in a database. You can modify it to fit your specific needs. Just copy it and paste it into a text file called basDocumentDatabase.bas (not .txt), then import it into your code.
Attribute VB_Name = "basDocumentDatabase"
Option Compare Database
Option Explicit
'=========================================================
' requires a references to
'    Microsoft DAO 3.x Object Library
'    Microsoft Scripting Runtime
'=========================================================
Public Sub DocDatabase(ByVal strFilePath As String, ByVal blnIncludeTables As Boolean)
' uses the undocumented [Application.SaveAsText] syntax
On Error GoTo Err_DocDatabase
    Dim dbs As DAO.Database
    Dim cnt As DAO.Container
    Dim doc As DAO.Document
    Dim i As Integer, strTablePath As String, strDelim As String
    Dim fso As New Scripting.FileSystemObject
    If right(strFilePath, 1) <> "/" And right(strFilePath, 1) <> "\" Then
        If InStr(1, strFilePath, "/") > 0 Then
            strDelim = "/"
        ElseIf InStr(1, strFilePath, "\") > 0 Then
            strDelim = "\"
        End If
        strFilePath = strFilePath & strDelim
    End If
    Set dbs = CurrentDb() ' use CurrentDb() to refresh Collections
    Set cnt = dbs.Containers("Forms")
    Debug.Print "Documenting Forms:"
    For Each doc In cnt.Documents
        Debug.Print "  " & doc.Name
        Application.SaveAsText acForm, doc.Name, strFilePath & doc.Name & ".txt"
        DoEvents
    Next doc
    Set cnt = dbs.Containers("Reports")
    Debug.Print "Documenting Reports:"
    For Each doc In cnt.Documents
        Debug.Print "  " & doc.Name
        Application.SaveAsText acReport, doc.Name, strFilePath & doc.Name & ".txt"
        DoEvents
    Next doc
    Set cnt = dbs.Containers("Scripts")
    Debug.Print "Documenting Macros:"
    For Each doc In cnt.Documents
        Debug.Print "  " & doc.Name
        Application.SaveAsText acMacro, doc.Name, strFilePath & doc.Name & ".txt"
        DoEvents
    Next doc
    Set cnt = dbs.Containers("Modules")
    Debug.Print "Documenting Modules:"
    For Each doc In cnt.Documents
        Debug.Print "  " & doc.Name
        Application.SaveAsText acModule, doc.Name, strFilePath & doc.Name & ".txt"
        DoEvents
    Next doc
    Debug.Print "Documenting Queries:"
    For i = 0 To dbs.QueryDefs.Count - 1
        Debug.Print "  " & dbs.QueryDefs(i).Name
        Application.SaveAsText acQuery, dbs.QueryDefs(i).Name, strFilePath & _
            dbs.QueryDefs(i).Name & ".txt"
        DoEvents
    Next i
    If blnIncludeTables Then
        Debug.Print "Documenting Tables:"
        For i = 0 To dbs.TableDefs.Count - 1
            If left(dbs.TableDefs(i).Name, 4) <> "MSys" Then
                Debug.Print "  " & dbs.TableDefs(i).Name
                strTablePath = strFilePath & dbs.TableDefs(i).Name & strDelim
                If Not fso.FolderExists(strTablePath) Then fso.CreateFolder strTablePath
                DoCmd.TransferText acExportDelim, , dbs.TableDefs(i).Name, _
                    strTablePath & dbs.TableDefs(i).Name & ".txt", True
            End If
            DoEvents
        Next i
    End If
    Set doc = Nothing
    Set cnt = Nothing
    Set dbs = Nothing
Exit_DocDatabase:
    Exit Sub
Err_DocDatabase:
    Select Case err
    Case Else
        MsgBox err.Description
        Resume Exit_DocDatabase
    End Select
End Sub
 
Public Sub DocTables(ByVal strFilePath As String)
' uses the undocumented [Application.SaveAsText] syntax
On Error GoTo Err_DocDatabase
    Dim dbs As DAO.Database
    Dim cnt As DAO.Container
    Dim doc As DAO.Document
    Dim i As Integer, strTablePath As String, strDelim As String
    Dim fso As New Scripting.FileSystemObject
    If right(strFilePath, 1) <> "/" And right(strFilePath, 1) <> "\" Then
        If InStr(1, strFilePath, "/") > 0 Then
            strDelim = "/"
        ElseIf InStr(1, strFilePath, "\") > 0 Then
            strDelim = "\"
        End If
        strFilePath = strFilePath & strDelim
    End If
    Set dbs = CurrentDb() ' use CurrentDb() to refresh Collections
    For i = 0 To dbs.TableDefs.Count - 1
        If left(dbs.TableDefs(i).Name, 4) <> "MSys" Then
            Debug.Print dbs.TableDefs(i).Name
            strTablePath = strFilePath & dbs.TableDefs(i).Name & strDelim
            If Not fso.FolderExists(strTablePath) Then fso.CreateFolder strTablePath
            DoCmd.TransferText acExportDelim, , dbs.TableDefs(i).Name, _
                strTablePath & dbs.TableDefs(i).Name & ".txt", True
        End If
        DoEvents
    Next i
    Set doc = Nothing
    Set cnt = Nothing
    Set dbs = Nothing
Exit_DocDatabase:
    Exit Sub
Err_DocDatabase:
    Select Case err
    Case Else
        MsgBox err.Description
        Resume Exit_DocDatabase
    End Select
End Sub
 
Public Sub DocTableLinks(ByVal strFilePath As String)
On Error GoTo Err_DocDatabase
    Dim dbs As DAO.Database
    Dim cnt As DAO.Container
    Dim doc As DAO.Document
    Dim i As Integer
    Dim fso As New Scripting.FileSystemObject
    Set dbs = CurrentDb() ' use CurrentDb() to refresh Collections
    For i = 0 To dbs.TableDefs.Count - 1
        If left(dbs.TableDefs(i).Name, 4) <> "MSys" Then
            If Not IsNull(dbs.TableDefs(i).Connect) And Len(Trim(dbs.TableDefs(i).Connect)) > 0 Then
                Debug.Print Replace(dbs.Name, strFilePath, "") & "," & dbs.TableDefs(i).Name & "," & _
                    Replace(dbs.TableDefs(i).Connect, ";DATABASE=", "")
            End If
        End If
        DoEvents
    Next i
    Set doc = Nothing
    Set cnt = Nothing
    Set dbs = Nothing
Exit_DocDatabase:
    Exit Sub
Err_DocDatabase:
    Select Case err
    Case Else
        MsgBox err.Description
        Resume Exit_DocDatabase
    End Select
End Sub
 
Public Sub DocQueries()
    Dim dbs As DAO.Database, intFileNum As Integer, strType As String
    Dim intQuery As Integer, strFilePath As String, strQuery As String
    Set dbs = CurrentDb() ' use CurrentDb() to refresh Collections
    strFilePath = Environ("USERPROFILE") & "\Desktop\Queries.csv"
    ' get a file number
    intFileNum = FreeFile()
    ' open the file for writing
    Open strFilePath For Output As #intFileNum
    ' add the Header string,
    Print #intFileNum, "Name,Type,SQL"
    ' loop through the queries
    For intQuery = 0 To dbs.QueryDefs.Count - 1
        ' translate the query type
        strType = TranslateQueryTypes(dbs.QueryDefs(intQuery))
        ' if the query is valid
        If left$(Trim(dbs.QueryDefs(intQuery).Name), 1) <> "~" Then
            ' create the query string
            strQuery = dbs.QueryDefs(intQuery).Name & "," & strType & ",""" & _
                Trim(Replace(dbs.QueryDefs(intQuery).Sql, vbNewLine, " ")) & """"
            ' output the query string
            Print #intFileNum, strQuery
        End If
    Next intQuery
    ' close the file
    Close #intFileNum
End Sub
 
Private Function TranslateQueryTypes(ByRef qry As DAO.QueryDef) As String
    Select Case qry.Type
        Case dbQAction
            TranslateQueryTypes = "Action"
        Case dbQAppend
            TranslateQueryTypes = "Append"
        Case dbQCompound
            TranslateQueryTypes = "Compound"
        Case dbQCrosstab
            TranslateQueryTypes = "CrossTab"
        Case dbQDDL
            TranslateQueryTypes = "DataDefinition"
        Case dbQDelete
            TranslateQueryTypes = "Delete"
        Case dbQMakeTable
            TranslateQueryTypes = "MakeTable"
        Case dbQSelect
            TranslateQueryTypes = "Select"
        Case dbQSetOperation
            TranslateQueryTypes = "Union"
        Case dbQUpdate
            TranslateQueryTypes = "Update"
    End Select
End Function
 
Public Sub LoadDatabase(ByVal strFilePath As String, ByVal strObjectName As String, _
  ByVal strObjectType As String)
' uses the undocumented [Application.LoadFromText] syntax
On Error GoTo Err_LoadDatabase
    Dim dbs As DAO.Database
    Dim cnt As DAO.Container
    Dim doc As DAO.Document
    Set dbs = CurrentDb() ' use CurrentDb() to refresh Collections
    Select Case strObjectType
        Case "Table"
            DoCmd.TransferText acImportDelim, , strObjectName, strFilePath, True
        Case "Form"
            Application.LoadFromText acForm, strObjectName, strFilePath
        Case "Report"
            Application.LoadFromText acReport, strObjectName, strFilePath
        Case "Script"
            Application.LoadFromText acMacro, strObjectName, strFilePath
        Case "Module"
            Application.LoadFromText acModule, strObjectName, strFilePath
        Case "Query"
            Application.LoadFromText acQuery, strObjectName, strFilePath
        Case Else
            MsgBox "The object type must be a Table, Form, Report, Script, Module, or Query", _
                vbExclamation, "Object Type Error"
    End Select
Exit_LoadDatabase:
    Exit Sub
Err_LoadDatabase:
    Select Case err
    Case Else
        MsgBox err.Description
        Resume Exit_LoadDatabase
    End Select
End Sub
 
Public Sub TestDocDatabase()
    DocDatabase "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop", True
End Sub
 
Public Sub TestDocTables()
    DocTables "\\cagold01fps01\Accounting\1_ACCG_SAC_MA\PERM_REF_DATA\REVENUE"
End Sub
 
Public Sub TestLoadDatabase()
    LoadDatabase "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\qryTest.txt", _
        "qryTest", "Query"
End Sub
 
Public Sub TestLoadDatabaseTable()
    LoadDatabase "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\CSID\Tables\zstblNotes\zstblNotes.txt", _
        "zstblNotes2", "Table"
End Sub
 
Public Sub TestDocTableLinks()
    DocTableLinks "\\cagold01fps01\accounting\1_ACCG_SAC_MA\PERM_REF_DATA\FLEET\"
End Sub

Open in new window

0
 
LVL 85

Accepted Solution

by:
Scott McDaniel (Microsoft Access MVP - EE MVE ) earned 400 total points
ID: 24331790
Note that there are many 3rd party components that do this; cwood has put you on the right path, but you'll likely need to use ADOX to really get down to the details on a SQL Server. I use the products from Red Gate software (www.red-gate.com). They are pricey, but work extremely well.
0
 

Author Comment

by:schmir1
ID: 24337520
Since I'm pressed for time, I'm going to try the Red Gate SQL Compare program.  Sounds like it's what I want although I will miss not having the source code to play with.
0
 

Author Comment

by:schmir1
ID: 24340450
I've been rethinking my approach to getting my Access production data into my new SQL Server.  I think the best way is to use my new table designs which is on the SQL Server and copy the Access production data into it.  Unfortunately, I don't know how to do this.  I think I'll open up a new question for this new approach.

I think the Red Gate tools will work for what I need in the future.  That is once I get the Access Data copied to the SQL Server.  Then I will be just comparing two SQL Server databases.

For now I need something else.

Thanks for your help.
0
 

Author Closing Comment

by:schmir1
ID: 31579227
Thanks you both.
0

Featured Post

The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Phishing attempts can come in all forms, shapes and sizes. No matter how familiar you think you are with them, always remember to take extra precaution when opening an email with attachments or links.
As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

634 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question