Solved

VBA to compare two SQL Server Database table structure

Posted on 2009-05-07
5
649 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
  • 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 84

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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

QuickBooks® has a great invoice interface that we were happy with for a while but that changed in 2001 through no fault of Intuit®. Our industry's unit names are dictated by RUS: the Rural Utilities Services division of USDA. Contracts contain un…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
Familiarize people with the process of utilizing SQL Server stored procedures from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Micr…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…

839 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