Rename DTS Tasks / Steps for Logging

'**********************************************************************
'* Fun With ActiveX Scripts
'**********************************************************************
'* Rename Tasks and Steps for Meaningful Log Text
'**********************************************************************
'* Author: 
'* Lane Tharp 
'* CountryWide Financial Services
'* Performance Management Group
'* Plano, Texas
'* 2004/12/31
'* ----------------------------------------
'* Description:
'* This Script renames the Tasks and Steps of a DTS Package to the task description.
'* This makes the DTS Package Execution Logs meaningful and useful for debugging.
'* ----------------------------------------
'* Caution:
'* This script can generate a DTS Package that is not editable if used incorrectly. 
'* This script will create a copy of the host script and rename the copy.
'* This copy will be created on the (Local) Server.
'* This copy will be editable but the layout will be redone by SQL Server.
'* NEVER SAVE AFTER RUNNING THIS SCRIPT OR THE PACKAGE WILL NOT BE EDITABLE.
'* ----------------------------------------
'* Useage:
'* 1. Add an ActiveX Script Task to Package being renamed in DTS Designer. 
'* 2. Disable this Task in workflow properties so it does not run with package. 
'* 3. Copy this script into the ActiveX Task. 
'* 4. The (local) SA SQL User and password are required to make the renamed copy. 
'*     - Find "SA" and supply the password in the parameter after "SA". 
'*     - IE: "SA", "password"
'* 5. Make a backup copy of the package. (Do not skip this step) 
'* 6. Save the package. (Do not skip this step) 
'* 7. Execute the ActiveX script in DTS Designer and close the package without saving.
'* 8. Refresh the "Local Packages" node in Enterprise Manager and look for a new 
'*     package with "_Renamed" added to the name.
'**********************************************************************
'-------------------------------------------------------------------------------------
' Big Fat Clarifying Note:                                                (Be clear on this) 
' - Steps are named after the tasks they constrain precedence for by DTS.
' - Step Names are not the *description* shown in workflow properties, they 
'    are the *name* shown in the disconnected edit properties. 
'-------------------------------------------------------------------------------------
' Naming Convention:
' - Old Name Format: "DTSTask_DTSExecuteSQLTask_1" 
' - Old Name Description: "Load Table"
' - New Name Format: "TaskExecuteSQL_LoadTable_1" 
' - IE:"Object+Type+_Delimiter+PreparedDescriptionText+_Delimiter_Sequence"
' Naming Note: 
' - Underscore in name is necessary to demarcate name from task type 
'    in future renaming.
' - Sequence in name is necessary to eliminate duplicate names
'-------------------------------------------------------------------------------------
' Debug Note:
' - This script is not intended for unnattended execution.
' - Do not edit scripts in the ActiveX Task Properties in DTS. (You will go blind.)
' - Edit as .vbs file in, and *debug* scripts in the Microsoft Script Editor. 
'-------------------------------------------------------------------------------------
'************
'* Main
'************
Function Main()
    Dim loPackage
    Dim lsPackageName
    'Stop
    Main = DTSTaskExecResult_Success 
    ' Get Package Object
    Set loPackage = DTSGlobalVariables.Parent
    ' Save Name
    lsPackageName = loPackage.Name
    ' Rename Tasks in Copy of Package
    If RenameTasks(loPackage) = False Then _
        Main = DTSTaskExecResult_Failure
    ' Save Renamed Copy of Package (Editable)
    ' Note: Package Object Referenced to new name
    loPackage.SaveToSQLServerAs lsPackageName & "_Renamed", "(Local)", "SA", "enigma"
    ' Destroy Objects
    Set loPackage = Nothing
End Function
'*****************
'* Rename Tasks
'*****************
Function RenameTasks(ByRef loPackage)
    On Error Resume Next
    '--------------
    ' Debug'Stop
   'Stop
    Dim loTask
    Dim loTasks
    Dim loProperties
    Dim loProperty
    Dim lnStart
    Dim lnLength
    Dim lsTaskType
    Dim lsDescription
    Dim lsTaskNameNew
    Dim lsTaskNameOld
    Dim lnNameSequence
    Dim lsMessage
    '--------------------------
    ' Initialize
    RenameTasks = True
    lnNameSequence = 0
    ' Get Tasks Collection
    Set loTasks = loPackage.Tasks
    '----------------------
    ' Loop Through Tasks
    For Each loTask In loTasks
        ' Increment Name Sequence
        lnNameSequence = lnNameSequence + 1
        ' Initialize Names
        lsTaskNameNew = ""
        lsTaskNameOld = loTask.Name
        '-------------------------------
        ' Task has not been Renamed
        '-------------------------------
        ' Old Name Format: "DTSTask_DTSExecuteSQLTask_1" 
        If Left(loTask.name,8) = "DTSTask_" Then 
            '-----------------------
            ' Generate New Name 
            ' Remove DTSTask_ From Old Name
            lsWork = Mid(loTask.name,9,Len(loTask.name))
            ' Task Type - Get Type Description From Old Name 
            lsTaskType = Left(lsWork,InStr(lsWork,"_")-1) 
            ' Task Type - Strip "DTS" From Begining and "Task" From End of Old Task Type 
            lsTaskType = Mid(lsTaskType,4,Len(lsTaskType)-7)
            ' Prepare Description Text for use in Name
            lsDescription = PrepareNameFromDescription(loTask.Description)
            ' New Name = "Object+Type+_Delimiter+PreparedDescriptionText"
            lsTaskNameNew = _
                "Task" + lsTaskType + "_" + _
                lsDescription + "_" + Cstr(lnNameSequence)
            ' Check For Errors
            If Err.Number <> 0 Then 
               'Stop '<---- Opens Debugger
                RenameTasks = False ' <- Fail Script
            End If   
        '-----------------------------------
        ' Task has already been renamed
        '-----------------------------------
        ' New Name Format: "TaskExecuteSQL_LoadTable_1" 
        Else 
            '--------------------------------------------------------------
            ' Verify naming Convention for change in task description
            ' Get Description From Name
            lsWork = Mid(loTask.Name,InStr(loTask.Name,"_") + 1)
            lsWork = Mid(lsWork,1,InStr(loTask.Name,"_") - 1)
            ' Get Description Text to verify Name
            lsDescription = PrepareNameFromDescription(loTask.Description)
            ' Populate New from old in case of no change
            lsTaskNameNew = lsTaskNameOld
            ' Check for change in description
            If lsWork <> lsDescription Then
                ' Rename with new description
                lsTaskNameNew = _
                    Left(loTask.Name,InStr(loTask.Name,"_")) + _
                    lsDescription + "_" + Cstr(lnNameSequence)
            End If
            ' Check For Errors
            If Err.Number <> 0 Then 
               'Stop '<---- Opens Debugger
                RenameTasks = False ' <- Fail Script
            End If    
        End If 
        '<-- Exit #1
        If RenameTasks = True Then
        '---------------------------
        ' Change Name if Changed
        If lsTaskNameNew <> lsTaskNameOld Then
            ' Rename task
            loTask.Name = lsTaskNameNew
            ' Check For Errors
            If Err.Number <> 0 Then
               'Stop '<---- Opens Debugger
                RenameTasks = False ' <- Fail Script
            End If    
            '<-- Exit #2
            If RenameTasks = True Then
            '------------------------------------------
            ' Change name in all referencing steps 
            If RenameTaskStep( _
            loPackage, lsTaskNameOld, lsTaskNameNew) = False Then
                ' Step Rename Failed    
                loTask.Name = lsTaskNameOld
               'Stop ' <-- Activates Debugger
                RenameTasks = False ' <- Fail Script
            End If
            '<-- Exit #2
            End If
        End If
        '<-- Exit #1
        End If
    Next
    ' Destroy Objects
    Set loTask = Nothing
    Set loTasks = Nothing
    ' Check For Errors
    If Err.Number <> 0 Then 
       'Stop '<---- Opens Debugger
        Main = DTSTaskExecResult_Failure ' <- Fail Script
    End If   
End Function
'***********************************************
'* Rename Task In Step
'***********************************************
Function RenameTaskStep(ByRef loPackage, lsTaskNameOld, lsTaskNameNew)
    On Error Resume Next 
    Dim loStep
    Dim loSteps
    Dim lsStepNameOld
    Dim lsStepNameNew
    RenameTaskStep = True
    '----------------------------------------
    ' Establish Old And New Step Names
    ' Old step was not renamed
    If Left(lsTaskNameOld,8) = "DTSTask_" Then
        lsStepNameOld = "DTSStep_" + Mid(lsTaskNameOld, 9)
    ' Old step was renamed
    Else
        lsStepNameOld = "Step" + Mid(lsTaskNameOld,5)       
    End If
    lsStepNameNew = "Step" + Mid(lsTaskNameNew,5)
    ' Check For Errors
    If Err.Number <> 0 Then 
       'Stop '<---- Opens Debugger
        RenameTaskStep = False ' <- Fail Function
    End If   
    '<-- Exit #1
    If RenameTaskStep = True Then
    '--------------------------
    ' Rename Task Step
    Set loSteps = loPackage.Steps
    Set loStep = loSteps.Item(Cstr(lsStepNameOld))
    loStep.Name = lsStepNameNew
    loStep.TaskName = lsTaskNameNew
    '---------------------------------------------------------------
    ' Correct Step name in other Step precedence Constraints
    If RenameStepInPresedenceConstraints( _
        loPackage, lsStepNameOld, lsStepNameNew) = False Then
        ' Step Rename Failed    
        loStep.Name = lsStepNameOld ' <-- Reverse Change
       'Stop ' <-- Activates Debugger
        RenameTaskStep = False ' <- Fail Function
    End If
    '<-- Exit #1
    End If
    ' Destroy Objects
    Set loStep = Nothing
    Set loSteps = Nothing
    ' Check For Errors
    If Err.Number <> 0 Then 
       'Stop '<---- Opens Debugger
        RenameTaskStep = False ' <- Fail Function
    End If   
End Function  
'***********************************************
'* Rename Step In Precedence Constraints
'***********************************************
Function RenameStepInPresedenceConstraints(_
    ByRef loPackage, lsStepNameOld, lsStepNameNew)
    On Error Resume Next 
    Dim loStep
    Dim loSteps
    Dim loPrecedenceConstraints 
    Dim loPrecedenceConstraint 
    RenameStepInPresedenceConstraints = True
    '-------------------
    ' Loop Steps
    Set loSteps = loPackage.Steps    
    For Each loStep in loPackage.Steps
        Set loPrecedenceConstraints = loStep.PrecedenceConstraints
        ' Loop Presedence Constraints
        For Each loPrecedenceConstraint in loPrecedenceConstraints
            If loPrecedenceConstraint.StepName = lsStepNameOld Then             
                loPrecedenceConstraint.StepName = lsStepNameNew
            End If            
        Next
    Next
    ' Destroy Objects
    Set loStep = Nothing
    Set loSteps = Nothing
    Set loPrecedenceConstraint = Nothing
    Set loPrecedenceConstraints = Nothing
    ' Check For Errors
    If Err.Number <> 0 Then 
       'Stop '<---- Opens Debugger
        RenameStepInPresedenceConstraints = False ' <- Fail Script
    End If    
End Function  
'***********************************************
'* Prepare Task Name From Description
'***********************************************
Function PrepareNameFromDescription(lsDescription)
    On Error Resume Next
    Dim lsWork
    Dim lnStart
    PrepareNameFromDescription = "??????????????"
    ' Copy Description
    lsWork = lsDescription
    ' Trim Work String
    lsWork = Trim(lsWork)
    ' Check For Errors
    If Err.Number <> 0 Then 
       'Stop '<---- Opens Debugger
        Exit Function ' <----- Returns Question Marks 
    End If   
    ' Remove Spaces
    Do
        lnStart = InStr(lsWork," ")
        If lnStart = 0 Then Exit Do
        lsWork = Left(lsWork,lnStart-1) & Right(lsWork, Len(lsWork)-lnStart)
    Loop
    ' Check For Errors
    If Err.Number <> 0 Then 
       'Stop '<---- Opens Debugger
        Exit Function ' <----- Returns Question Marks 
    End If    
    ' Remove UnderScores
    Do
        lnStart = InStr(lsWork,"_")
        If lnStart = 0 Then Exit Do
        lsWork = Left(lsWork,lnStart-1) & Right(lsWork, Len(lsWork)-lnStart)
    Loop
    ' Check For Errors
    If Err.Number <> 0 Then 
       'Stop '<---- Opens Debugger
        Exit Function ' <----- Returns Question Marks 
    End If   
    ' Return Prepared Name
    PrepareNameFromDescription = lsWork
End Function
'*******************************************************
'* Graveyard
'*******************************************************
            ' Enum Properties
'           'Stop
'            lsMessage = "-----------------------------------------------------------" & Chr(13)
'            lsMessage = "Properties For Task: " & loTask.Name & " " & Chr(13)
'            lsMessage = "-----------------------------------------------------------" & Chr(13)
'            Set loProperties = loTask.Properties
'            For Each loProperty In loProperties
'                If loProperty.Get Then
'                    lsMessage = loProperty.Name & ": " & loProperty.Value & Chr(13)
'                End If
'            Next