Solved

VBA to compare two SQL Server Database table structure

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

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

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

Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
Familiarize people with the process of utilizing SQL Server views 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 Access…
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…

813 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

18 Experts available now in Live!

Get 1:1 Help Now