'      SQL-DMO to generate MASTER SCRIPT REPOSITORY

'

'      November 15, 2009

'      use MS-Access and SQL-DMO to generate DROP/CREATE statements

'      for all views, stored procedures, and user-defined functions

'      placed in 3 folders, with separate file for each object

'

'   these code modules require the following references:

'

'       Microsoft SQLDMO Object Library

'

'       Name:       SQLDMO

'       FullPath:   C:\Program Files\Microsoft SQL Server\80\Tools\binn\SQLDMO.DLL

'       Guid:       {10010001-E260-11CF-AE68-00AA004A34D5}

'

'

'       Microsoft Scripting Runtime

'

'       Name:       Scripting

'       FullPath:   C:\WINDOWS\system32\scrrun.dll

'       Guid:       {420B2830-E718-11CF-893D-00A0C9054228}

'

 

Global Const my_db_name = "MY_MSSQL_DATABASE"

Global Const my_server = "MY_MSSQL_SERVER"

Global Const my_user = "MY_MSSQL_LOGIN"

 

Sub GenerateScripts()

    GenerateScripts_setup

    '

    GenerateScript "VIW"

    GenerateScript "PRC"

    GenerateScript "FNC"

    '

    MsgBox "Script generation is complete", vbInformation

End Sub

 

Sub GenerateScripts_setup()

    Dim fso As FileSystemObject

    Dim oFolder As String

    '

    Dim sFolder As String, sPath As String

    '

    Set fso = CreateObject("Scripting.FileSystemObject")

    sPath = CurrentProject.Path & "\"

    '

    sFolder = sPath & "VIW"

    If Not fso.FolderExists(sFolder) Then

        fso.CreateFolder (sFolder)

    End If

    '

    sFolder = sPath & "PRC"

    If Not fso.FolderExists(sFolder) Then

        fso.CreateFolder (sFolder)

    End If

    '

    sFolder = sPath & "FNC"

    If Not fso.FolderExists(sFolder) Then

        fso.CreateFolder (sFolder)

    End If

End Sub

 

Sub GenerateScript(object_type As String)

    Dim svr As SQLDMO.SQLServer

    Dim dbs As SQLDMO.Database

    Dim viw As SQLDMO.View

    Dim prc As SQLDMO.StoredProcedure

    '

    Dim db2 As SQLDMO.Database2

    Dim fnc As SQLDMO.UserDefinedFunction

    '

    Dim sql As String

    Dim outfolder As String, outfile As String

    Dim object_name As String, object_date As String

    '

    On Error GoTo err_sub

    '

    DoCmd.Hourglass True

    '

    ' init output file

    outfolder = CurrentProject.Path & "\" & object_type & "\"

    '

    ' SERVER

    Set svr = New SQLDMO.SQLServer

    svr.LoginSecure = True

    svr.Connect my_server

    '

    ' DATABASE

    Set dbs = svr.Databases(my_db_name, "dbo")

    '

    Select Case object_type

        Case "VIW"

            ' VIEWS

            For Each viw In dbs.Views

                If Not viw.SystemObject Then

                    sql = viw.Script

                    object_name = viw.Name

                    object_date = viw.CreateDate

                    outfile = outfolder & object_name & ".sql"

                    Open outfile For Output As #1

                    Write_Header object_name, object_date

                    Drop_Object object_type, object_name

                    Print #1, sql

                    Grant_Object object_type, object_name

                    Close #1

                End If

            Next viw

        Case "PRC"

            ' STORED PROCEDURES

            For Each prc In dbs.StoredProcedures

                If Not prc.SystemObject Then

                    sql = prc.Script

                    object_name = prc.Name

                    object_date = prc.CreateDate

                    outfile = outfolder & object_name & ".sql"

                    Open outfile For Output As #1

                    Write_Header object_name, object_date

                    Drop_Object object_type, object_name

                    Print #1, sql

                    Grant_Object object_type, object_name

                    Close #1

                End If

            Next prc

        Case "FNC"

            ' FUNCTIONS

            Set db2 = svr.Databases(my_db_name, "dbo")

            '

            For Each fnc In db2.UserDefinedFunctions

                If Not fnc.SystemObject Then

                    sql = fnc.Script

                    object_name = fnc.Name

                    object_date = fnc.CreateDate

                    outfile = outfolder & object_name & ".sql"

                    Open outfile For Output As #1

                    Write_Header object_name, object_date

                    Drop_Object object_type, object_name

                    Print #1, sql

                    Grant_Object object_type, object_name

                    Close #1

                End If

            Next fnc

        Case Else

            ' not recognized

    End Select

exit_sub:

    DoCmd.Hourglass False

    '

    Set dbs = Nothing

    Set db2 = Nothing

    svr.Disconnect

    Set svr = Nothing

    Exit Sub

'

err_sub:

    MsgBox Err.Description, , "Error # " & Err.Number

    Resume exit_sub

    '

End Sub

 

Sub Drop_Object(object_type As String, object_name As String)

    Print #1, "IF OBJECT_ID('dbo." & object_name & "') IS NOT NULL"

    Select Case object_type

        Case "VIW"

            Print #1, "DROP VIEW dbo." & object_name

        Case "PRC"

            Print #1, "DROP PROC dbo." & object_name

        Case "FNC"

            Print #1, "DROP FUNCTION dbo." & object_name

    End Select

    Print #1, "GO"

    Print #1, ""

End Sub

 

Sub Grant_Object(object_type As String, object_name As String)

    Select Case object_type

        Case "VIW"

            Print #1, "GRANT SELECT ON dbo." & object_name & " TO " & my_user

            Print #1, "GO"

        Case "PRC", "FNC"

            Print #1, "GRANT EXECUTE ON dbo." & object_name & " TO " & my_user

            Print #1, "GO"

    End Select

End Sub

 

Sub Write_Header(object_name As String, object_date As String)

    Print #1, String(60, "-")

    Print #1, "/*"

    Print #1, vbTab; "Server:"; vbTab; my_server

    Print #1, vbTab; "Database:"; vbTab; my_db_name

    Print #1, vbTab; "Object:"; vbTab; object_name

    Print #1, vbTab; "Created: "; vbTab; Format(Left(object_date, 15), "ddd mmm dd yyyy hh:nn AMPM")

    Print #1, vbTab; "Scripted:"; vbTab; Format(Now(), "ddd mmm dd yyyy hh:nn AMPM")

    Print #1, "*/"

    Print #1, String(60, "-")

End Sub