Using Visual Basic with SQL-DMO and SQL-NS

Disclaimer:

This code is free for anyone to use. No one
may sell it, lease it, rent it, or otherwise charge or collect fees for it.
Also by using this code you release me and the people you downloaded this
example code from, from any and all legal recourse for anything this code may
do to your database or computer systems.

As all of you know reading this
article “What is SQL-DMO, let alone SQL-NS”. Well the myth is about to be
uncovered in this multipart demonstration. I plan to show you how to use each
of these features for database information, scheduling, and other information
purposes with some generic functions and examples. You can do anything that
SQL Server Enterprise Manager can do. Also some of the functions in SQL-NS
give more information than going through SQL Server EM. Why I don’t know but
they do even thought they are supposed to be the same API function calls.

The only requirements are that you have good VB and SQL
Server experience. Whatever you do don’t run this code on production boxes,
this is meant for example purposes only.

Definitions

SQL-DMO (Distributed Management Objects)

Is a collection of objects that
encapsulate SQL Server’s database, scheduling, and replication management.

SQL-NS (Namespace)

Is a collection of objects that encapsulate SQL
Server’s enterprise manager functionality.

Help references

BOK (Books Online)

SQL Distributed Management Objects

SQL Namespace

WROX

SQL Server 7.0 SQL-DMO, SQL-NS, & DTS

Note:

When programming in SQL-NS in VB there is a
missing file (feature) that Microsoft did not include called the “sqlns.hlp”
file so you will have to refer to my code for examples and to books online.



SQL-DMO

In this segment, we will explore the following using SQL-DMO
(the next segment will add in the SQL-NS):

1.      How
to get a list of the servers via (frmMenu)

a.       Mod1. GetSrvNames()

                                                                          
i.     
SQL-DMO to get a list of all of the SQL Servers running on the domain
you are logged into.

                                                                        
ii.     
In the following code we create a SQLDMO Application, and a NameList
object in which we fill with avaible SQL Server names running on the same
domain.

			Public Function GetSrvNames()
    
			Dim iCount As Integer
			Dim DMOApp As SQLDMO.Application
			Dim DMONameList As SQLDMO.NameList

			On Error GoTo Err

				' Create the Application object
				Set DMOApp = New SQLDMO.Application
				' Get the list of servers
				Set DMONameList = DMOApp.ListAvailableSQLServers

				'Get the server names
				For iCount = 1 To DMONameList.Count
				   frmMenu.cmbSrvName.AddItem DMONameList(iCount)
				Next

				' Close the objects
				Set DMONameList = Nothing
				Set DMOApp = Nothing

			Err:
				Resume Next 'Replace with good error handling

			End Function

2.      How
to connect to a SQL Server (frmMenu)

a.       Mod1.SQL_CONNECTOR(Form
Name as parameter)

                                                                          
i.     
Connect to SQL Server via SQL-DMO

                                                                        
ii.     
Below we create a SQLDMO Server object and then connect to it via
trusted connection or the “sa” login based on the option chosen in the initial
logon screen.

			Public Function SQL_CONNECTOR(objForName As Object)
    
			    ' SQLDMO Connect string
			    Set MySqlServer = CreateObject("SQLDMO.SQLServer")
    
			    If bConnected = True Then
			        MySqlServer.Connect ServerName:=sSRVNameDMO, _
		            		Login:="sa", _
		            		Password:=sPassword
			    Else
			        MySqlServer.LoginSecure = True
			        MySqlServer.Connect ServerName:=sSRVNameDMO
			    End If
 
			End Function

3.      How
to do some basic table maintenance and get the scripting (frmMaint)

a.       Form_Load()

                                                                          
i.     
SQL-DMO on how to get a list of databases on the server you are logged
into.

                                                                        
ii.     
Here we use a simple combo box and populate it with all of the available
database names.

			Private Sub Form_Load()

			Dim Db As Object

			On Error GoTo LOAD_ERROR

				frmMaint.MousePointer = 13

				Call SQL_CONNECTOR(frmMaint)

				' Fill the Combo Box on the form with the available databases by 
				' using the SQL Server databases collection
				For Each Db In MySqlServer.Databases
				    ' Make sure is ok
				    If Db.Status <> 992 Or Db.Status <> 32768 Or Db.Status <> 32 Or Db.Status <> 512 _
				    Or Db.Status <> 192 Or Db.Status <> 256 Then
				        cmbDatabase.AddItem Db.Name
				    Else
				        MsgBox "Database: """ + Db.Name _
				          + " "" is can not be accessed at this time.", _
				          vbCritical, "Database Error"
				    End If
				Next

				Set Db = Nothing

				' Set the combo box to the first database listed.
				If cmbDatabase.ListCount > 0 Then
				    cmbDatabase.ListIndex = 0
				End If

				' Get db infor on the selected database
				Call DBInfo

			LOAD_ERROR_Exit:
				frmMaint.MousePointer = 0
				Exit Sub

			LOAD_ERROR:
				Resume LOAD_ERROR_Exit

			End Sub

b.      cmdUpdateStats_Click()

                                                                          
i.     
Update the (DBCC UPDATESTATISTICS) statistics for the currently selected
table

                                                                        
ii.     
With this SQLDMO we can create a one touch button to run “DBCC
UPDATESTATISTICS” ( Hint. No more ISQL or having to remember the syntax )

			Private Sub cmdUpdateStats_Click()

			Dim WorkTable As SQLDMO.Table
			Dim iX As Integer

			On Error GoTo Up_Stats_Error
				frmMaint.MousePointer = 13

				DoEvents

				' Execute Update Statistics command on selected tables
				For iX = 0 To lstTables.Selected(lstTables.ListCount - 1)
				    Set WorkTable = WorkDB.Tables(lstTables.List(iX))
				    ' Update Statistics on the Table - using the UpdateStatistics Method
				    WorkTable.UpdateStatistics
				    ' Release the Work Table object
				    Set WorkTable = Nothing
				Next iX

			Up_Stats_Exit:
				MsgBox "Satistics Updated", vbInformation, "Statistics Updated"
				frmMaint.MousePointer = 0
				Exit Sub

			Up_Stats_Error:
				Me.MousePointer = 0
				Resume Next 'Replace with good error handling
				Resume Up_Stats_Exit

			End Sub

c.       cmdCheckIdent_Click()

                                                                          
i.     
Check the identity column (DBCC CHECKIDENT)

                                                                        
ii.     
This simple code issues another DBCC command to check the Identity
column of a table.

			Private Sub cmdCheckIdent_Click()

			Dim WorkTable As SQLDMO.Table
			Dim iX As Integer

			On Error GoTo Up_Identity_Error
				frmMaint.MousePointer = 13

				DoEvents

				' Execute CheckIdentityValue command on selected tables
				For iX = 0 To lstTables.Selected(lstTables.ListCount - 1)
				    Set WorkTable = WorkDB.Tables(lstTables.List(iX))
				    ' Check Identity values on the Table - using the CheckIdentityValue Method
				    If WorkTable.Attributes = 1 Then
				        WorkTable.CheckIdentityValue
				    End If

				    ' Release the Work Table object
				    Set WorkTable = Nothing
				Next iX

			Up_Identity_Exit:
				MsgBox "Identity Values Checked", vbInformation, "Check Identity"
				frmMaint.MousePointer = 0
				Exit Sub

			Up_Identity_Error:
				Me.MousePointer = 0
				Resume Next 'Replace with good error handling
				Resume Up_Identity_Exit

			End Sub

d.      cmdTruncate_Click()

                                                                          
i.     
Truncate all of the data in a table (TRUNCATE TABLE)

                                                                        
ii.     
Be careful with this code, it is the same as issing “TRUNCATE TABLE TableName,
and will delete all the data in that table just as fast as in the ISQL window.

			Private Sub cmdTruncate_Click()

			Dim WorkTable As SQLDMO.Table
			Dim iX As Integer
			Dim sTRUNOut As String

			On Error GoTo Up_Check_Error
				frmMaint.MousePointer = 13

				DoEvents

				If MsgBox("Do you want to truncate the tables selected?", vbYesNo, "Are you sure?") = vbYes Then
				    ' Execute Truncate Table command on selected tables
				    For iX = 0 To lstTables.Selected(lstTables.ListCount - 1)
				        Set WorkTable = WorkDB.Tables(lstTables.List(iX))

				        ' Use the TruncateData Method
				        WorkTable.TruncateData
				        MsgBox RTrim$(WorkTable.Name) & " Truncateded", vbInformation, "Table Truncate"
				        ' Release the Work Table object
				        Set WorkTable = Nothing
				    Next iX
				End If

			Up_Check_Exit:
				frmMaint.MousePointer = 0
				Exit Sub

			Up_Check_Error:
				Me.MousePointer = 0
				Resume Next 'Replace with good error handling
				Resume Up_Check_Exit

			End Sub

e.       cmdMemory_Click()

                                                                          
i.     
Shows memory used by SQL Server (DBCC MEMUSAGE)

                                                                        
ii.     
This DBCC command is in SQLDMO and is kept around for reverse
compatibility just like it says in BOL.

			Private Sub cmdMemory_Click()

			Dim WorkTable As SQLDMO.Table
			Dim iX As Integer
			Dim sTRUNOut As String

			On Error GoTo Up_Check_Error
				frmMaint.MousePointer = 13

				DoEvents

				' Check server memory
				MsgBox WorkDB.GetMemoryUsage, vbInformation, "MemoryUsage"

			Up_Check_Exit:
				frmMaint.MousePointer = 0
				Exit Sub

			Up_Check_Error:
				Me.MousePointer = 0
				Resume Next 'Replace with good error handling
				Resume Up_Check_Exit

			End Sub

4.      How
to get Job Maintenance information (frmScheduler)

a.       LoadTasks()

                                                                          
i.     
Retrieves names and counts of all jobs on the SQL Server

                                                                        
ii.     
This code simply goes through and gets a total count of all the jobs you
have and places their names in a listbox.

			Private Sub LoadTasks()

			Dim lTask As Object

			On Error GoTo LoadTasks_Error

				frmJobs.MousePointer = 13

				lstJobs.Clear

				For Each lTask In MySqlServer.JobServer.Jobs
				    lstJobs.AddItem lTask.Name
				Next

			LoadTasks_Exit:
				frmJobs.MousePointer = 0
				Set lTask = Nothing
				Exit Sub

			LoadTasks_Error:
				Me.MousePointer = 0
				Resume Next 'Replace with good error handling
				Resume LoadTasks_Exit

			End Sub

b.      LoadInfo()

                                                                          
i.     
Retrieves information on the currently selected job

                                                                        
ii.     
This long procedure is rather simple in that it retrieves basic
information on a job some of which may not be readily avaible even in EM, or
you might have to dig deep in the GUI to get to it.

			Private Sub LoadInfo()

			Dim iX As Integer
			Dim WorkJob As SQLDMO.Job
			Dim iJ As String
			Dim sMonth As String
			Dim sYear As String
			Dim sDay As String

			On Error GoTo LoadInfo_Error

				frmJobs.MousePointer = 13

				If lstJobs.ListIndex = -1 Then
				        Exit Sub
				End If

				For iX = lstJobs.ListCount - 1 To 0 Step -1
				    If lstJobs.Selected(iX) = True Then

				        ' Set icount for the history and add job
				        Set WorkJob = SQLSRVJOB.Jobs(lstJobs.List(iX))

				        ' Job owner
				        txtJobOwner.Text = RTrim$(WorkJob.Owner)

				        ' Create date
				        txtDateCreated.Text = RTrim$(WorkJob.DateCreated)


				        ' Run Status
				        iJ = RTrim$(WorkJob.CurrentRunStatus)
				            Select Case iJ
				                Case "3"
				                    txtRunStatus.Text = "Job Between Retries"
				                Case "1"
				                    txtRunStatus.Text = "Job is executing"
				                Case "4"
				                    txtRunStatus.Text = "Job is idle"
				                Case "7"
				                    txtRunStatus.Text = "All executtable steps completed"
				                Case "5"
				                    txtRunStatus.Text = "Job Suspended"
				                Case "0"
				                    txtRunStatus.Text = "Cannot determine status"
				                Case "6"
				                    txtRunStatus.Text = "Awaiting step outcome"
				                Case "2"
				                    txtRunStatus.Text = "Job is blocked"
				            End Select

				        ' Run Step
				        txtRunStep.Text = RTrim$(WorkJob.CurrentRunStep)

				        ' Last Modified
				        txtLastModDate.Text = RTrim$(WorkJob.DateLastModified)

				        ' Description
				        txtDesc.Text = RTrim$(WorkJob.Description)

				        ' Enabled
				        txtEnabled.Text = RTrim$(WorkJob.Enabled)

				        ' LastRun Date
				        sYear = Left(RTrim$(WorkJob.LastRunDate), 4)
				        sMonth = Mid(RTrim$(WorkJob.LastRunDate), 5, 2)
				        sDay = Right(RTrim$(WorkJob.LastRunDate), 2)
				        If sYear = "0" And sMonth = "" And sDay = "0" Then
				            txtLastRunDate.Text = "Job never ran"
				        Else
				            txtLastRunDate.Text = Format(sMonth & sDay & sYear, "##/##/####")
				            ' Last run time
				            txtLastRunDate.Text = txtLastRunDate.Text & " - " & 
				            Format(RTrim$(WorkJob.LastRunTime), "##:##:##")
				        End If

				        ' Next Run Date
				        sYear = Left(RTrim$(WorkJob.NextRunDate), 4)
				        sMonth = Mid(RTrim$(WorkJob.NextRunDate), 5, 2)
				        sDay = Right(RTrim$(WorkJob.NextRunDate), 2)
				        If sYear = "0" And sMonth = "" And sDay = "0" Then
				            txtNRunDate.Text = "No Run Date"
				        Else
				            txtNRunDate.Text = Format(sMonth & sDay & sYear, "##/##/####")
				            ' Next Run Time
				            txtNRunDate.Text = txtNRunDate.Text & " - " & 
				            Format(RTrim$(WorkJob.NextRunTime), "##:##:##")
				        End If


				        ' Operator email
				        txtOprEmail.Text = RTrim$(WorkJob.OperatorToEmail)

				        ' Operator netsend
				        txtOprNetSend.Text = RTrim$(WorkJob.OperatorToNetSend)

				        ' Operator pager
				        txtOprPager.Text = RTrim$(WorkJob.OperatorToPage)

				        ' Pager notification levels
				        iJ = RTrim$(WorkJob.PageLevel)
				            Select Case iJ
				                Case "6"
				                    txtPagerLevel.Text = "Page regardless"
				                Case "3"
				                    txtPagerLevel.Text = "Page regardless"
				                Case "2"
				                    txtPagerLevel.Text = "Page on failure"
				                Case "0"
				                    txtPagerLevel.Text = "Do not page"
				                Case "1"
				                    txtPagerLevel.Text = "Page on success"
				                Case "4096"
				                    txtPagerLevel.Text = "Invalid Value"
				            End Select

				        ' Event Log level
				        iJ = RTrim$(WorkJob.EventlogLevel)
				            Select Case iJ
				                Case "0"
				                    txtEventLog.Text = "Always"
				                Case "1"
				                    txtEventLog.Text = "Log on success"
				                Case "2"
				                    txtEventLog.Text = "Log on failure"
				                Case "3"
				                    txtEventLog.Text = "Log on completion"
				            End Select

				        Set WorkJob = Nothing
				    End If
				Next


			LoadInfo_Exit:
				frmJobs.MousePointer = 0
				Exit Sub

			LoadInfo_Error:
				Me.MousePointer = 0
				Resume Next 'Replace with good error handling
				Resume LoadInfo_Exit

			End Sub

c.       cmdRefresh_Click()

                                                                          
i.     
Refreshes the information on the currently selected job.

                                                                        
ii.     
Refreshes the jobs job list and count on the user screen ( just in case
something has changed )

			Private Sub cmdRefresh_Click()

			Dim WorkJob As SQLDMO.Job
			Dim iX As Integer

			On Error GoTo cmdRefresh_Error

				frmJobs.MousePointer = 13

				For iX = lstJobs.ListCount - 1 To 0 Step -1
				    If lstJobs.Selected(iX) = True Then

				        Set WorkJob = SQLSRVJOB.Jobs(lstJobs.List(iX))

				        WorkJob.Refresh
				        MsgBox "Job - " & WorkJob.Name & " refreshed.", vbInformation, "Job Status"

				    End If
				Next

				Call LoadTasks

			cmdRefresh_Exit:
				frmJobs.MousePointer = 0
				Set WorkJob = Nothing
				Exit Sub

			cmdRefresh_Error:
				Me.MousePointer = 0
				Resume Next 'Replace with good error handling
				Resume cmdRefresh_Exit

			End Sub

I hope you find this information educational and learn from
it. You can built your own custom applications to do anything and then some
that you may rely heavily on EM for.

Other Code:

On to Part 2 of this article…

Latest Articles