' 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