Set logging properties for group of DTS packages

Option Explicit

Function Main()
	On Error Resume Next

	Dim oWsh ' Windows Scripting host object
	Dim oConn ' ADO connection object
	Dim oRS ' ADO recordset
	Dim sSQL ' SQL string to execute
	Dim sSvr ' server name
	Dim sUID ' user id
	Dim sPwd ' password
	Dim iSec ' security mode
	Dim oPkg ' DTS Package object
	Dim sPkgName ' DTS Package name
	Dim sPkgMatch ' String to match in package name
	Dim iPkgCnt ' count of packages in list
	Dim iPkgOk ' count of successfully changed packages
	Dim iErr ' error count
	Dim sMsg ' Message String

	sSvr = "<your server name>"
	sDb = "msdb"
	sUid = "<your user id>" ' leave as empty string if using trusted connection
	sPwd = "<your password>" ' leave as empty string if using trusted connection
	iSec = 256 ' 0=SQL Security, 256=Trusted Connection
	sPkgMatch = "<your pattern to match package names>"

	' create windows script object so we can log message to event log
	Set oWSh = CreateObject("WScript.Shell")
	' setup ADO connection and recordset objects
	Set oConn = CreateObject("ADODB.Connection")
	Set oRS = CreateObject("ADODB.Recordset")

	' build ADO connection string
	sConn = "Provider=SQLOLEDB.1"
	' check if using Integrated security or not
	If iSec = 256 Then
		' use integrated security, no username and password required
		sConn = sConn & ";Integrated Security=SSPI;Persist Security Info=False"
	Else
		' use SQL security, so must provide username and password
		sConn = sConn & ";Persist Security Info=True"
		sConn = sConn & ";User ID=" & sUID
		sConn = sConn & ";Password=" & sPwd
	End If
	sConn = sConn & ";Initial Catalog=" & sDb
	sConn = sConn & ";Data Source=" & sSvr

	' open ADO connection 
	oConn.Open sConn
	
	If Err.Number = 0 Then
		' build SQL Statement to load list of packages
		sSQL = "SELECT name FROM msdb.dbo.sysdtspackages WHERE name "
		sSQL = sSQL & "LIKE '" & sPkgMatch & "%'"
		' open recordset
		oRS.Open sSQL, oConn

		If Err.Number = 0 AND oRS.EOF = False Then
			iPkgCnt = 0
			iPkgOk = 0
			While oRS.EOF = False
				iPkgCnt = iPkgCnt + 1
				' assign value in recordset to variable
				sPkgName = oRS.Fields(0).Value
				Set oPkg = CreateObject("DTS.Package")
				oPkg.LoadFromSQLServer sSvr, sUID, sPwd, sSec, "", "", "", sPkgName
				If Err.Number = 0 Then
					oPkg.LogToSQLServer = True
					oPkg.LogServerFlags = sSec
					oPkg.LogServerName = sSvr
					oPkg.LogServerUserName = sUID
					oPkg.LogServerPassword = sPwd
					oPkg.SaveToSQLServer sSvr, sUID, sPwd, sSec
					If Err.Number = 0 Then
						iPkgOk = iPkgOk + 1
						sMsg = "Logging for DTS Package " & sPkgName & vbCrLf
						sMsg = sMsg & " has been successfully repointed to the "
						sMsg = sMsg & sSvr  & " server."
						oWsh.LogEvent 4, sMsg
						Err.Clear
					Else
						iErr = iErr + 1
						sMsg = "ERROR while trying to save DTS Package " & sPkgName & vbCrLf
						sMsg = sMsg & " after repointing logging to the "
						sMsg = sMsg & sSvr  & " server." & vbCrLf
						sMsg = sMsg & "Received following error:" & vbCrLf
						sMsg = sMsg & Err.Number & ": " & Err.Description
						oWsh.LogEvent 2, sMsg
						Err.Clear
					End If
				Else
					iErr = iErr + 1
					sMsg = "ERROR while trying to load DTS Package " & sPkgName & vbCrLf
					sMsg = sMsg & " to repoint logging to the "
					sMsg = sMsg & sSvr  & " server." & vbCrLf
					sMsg = sMsg & "Received following error:" & vbCrLf
					sMsg = sMsg & Err.Number & ": " & Err.Description
					oWsh.LogEvent 2, sMsg
					Err.Clear
				End If
				Set oPkg = Nothing
				oRS.MoveNext
			Wend
		Else
			iErr = iErr + 1
			sMsg = "ERROR while trying to retrieve list of Packages using "
			sMsg = sMsg & " SQL statement " & vbCrLf & sSQL & vbCrLf
			sMsg = sMsg & "Received following error:" & vbCrLf
			sMsg = sMsg & Err.Number & ": " & Err.Description
			oWsh.LogEvent 2, sMsg
			Err.Clear
		End If
	Else
		iErr = iErr + 1
		sMsg = "ERROR while trying to establish database connection "
		sMsg = sMsg & " using following connection string " & vbCrLf & sConn & vbCrLf
		sMsg = sMsg & "Received following error:" & vbCrLf
		sMsg = sMsg & Err.Number & ": " & Err.Description
		oWsh.LogEvent 2, sMsg
		Err.Clear
	End If

	If iErr = 0 Then
		sMsg = "Repointing of DTS Package logging completed." & vbCrLf
		If iPkgCnt > 0 Then
			sMsg = sMsg & "Successfully changed " & iPkgOk 
			sMsg = sMsg & " out of " & iPkgCnt & " packages." & vbCrLf
		End If
		sMsg = sMsg & "Check Windows Application Event log for detailed messages."
		oWsh.LogEvent 4, sMsg
		Main = DTSTaskExecResult_Success
	Else
		sMsg = "NOTE: " & CStr(iErr) & " errors occurred while trying to "
		sMsg = sMsg & "repoint DTS Package logging." & vbCrLf
		If iPkgCnt > 0 Then
			sMsg = sMsg & "Successfully changed " & iPkgOk 
			sMsg = sMsg & " out of " & iPkgCnt & " packages." & vbCrLf
		Else
			sMsg = sMsg & "No packages were changed!!" & vbCrLf
		End If
		sMsg = sMsg & "Check Windows Application Event log for detailed messages."
		oWsh.LogEvent 1, sMsg
		Main = DTSTaskExecResult_Failure
	End If


End Function