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