Sub ScriptDatabase(dbname
As String,
outfile As String)
'
' this procedure
requires a reference to:
'
' Microsoft SQLDMO Object Library
'
Dim svr As SQLDMO.SQLServer
Dim dbs As SQLDMO.Database
Dim tbl As SQLDMO.Table
Dim idx As SQLDMO.Index
Dim trg As SQLDMO.Trigger
Dim chk As SQLDMO.Check
Dim viw As SQLDMO.View
Dim prc As SQLDMO.StoredProcedure
'
Dim db2 As SQLDMO.Database2
Dim fnc As SQLDMO.UserDefinedFunction
'
Dim sql As String
'
On Error GoTo err_sub
'
Screen.MousePointer = vbHourglass
'
'
init output file
Open
outfile For Output As
#1
'
'
SERVER
Set svr = New SQLDMO.SQLServer
svr.LoginSecure = True
svr.Connect "localhost"
'
'
DATABASE
Set dbs = svr.Databases(dbname, "dbo")
sql = dbs.Script
Print #1,
sql
'
'
TABLES
For Each tbl In
dbs.Tables
If Not tbl.SystemObject Then
sql =
tbl.Script
Print
#1, sql
For
Each idx In tbl.Indexes
sql =
idx.Script
Print
#1, sql
Next
idx
For
Each trg In tbl.Triggers
sql =
trg.Script
Print
#1, sql
Next
trg
For
Each chk In tbl.Checks
sql =
chk.Script
Print
#1, sql
Next
chk
End If
Next tbl
'
'
VIEWS
For Each viw In
dbs.Views
If Not viw.SystemObject Then
sql =
viw.Script
Print
#1, sql
End If
Next viw
'
'
STORED PROCEDURES
For Each prc In
dbs.StoredProcedures
If Not prc.SystemObject Then
sql =
prc.Script
Print
#1, sql
End If
Next prc
'
'
FUNCTIONS
Set db2 = svr.Databases(dbname,
"dbo")
'
For Each fnc In
db2.UserDefinedFunctions
If Not fnc.SystemObject Then
sql =
fnc.Script
Print
#1, sql
End If
Next fnc
exit_sub:
Screen.MousePointer = vbDefault
Close #1
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