Solved

VBA to compare two SQL Server Database table structure

Posted on 2009-05-07
5
611 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Thanks you both.
0

Featured Post

Complete Microsoft Windows PC® & Mac Backup

Backup and recovery solutions to protect all your PCs & Mac– on-premises or in remote locations. Acronis backs up entire PC or Mac with patented reliable disk imaging technology and you will be able to restore workstations to a new, dissimilar hardware in minutes.

Join & Write a Comment

I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

772 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now