Solved

VBA to compare two SQL Server Database table structure

Posted on 2009-05-07
5
625 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

Backup Your Microsoft Windows Server®

Backup all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Question has a verified solution.

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

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…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Familiarize people with the process of utilizing SQL Server functions 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 Microsoft Ac…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

863 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

26 Experts available now in Live!

Get 1:1 Help Now