Backup All or one DTs Package(s)

Public bltrusted
Public strServerName
Public strUserName
Public strPassword
Public strBackupFolder
Public strPackageName
Public strLogFile
    
'************************************************************************
'* DTS Package Backup with ActiveX Scripts
'************************************************************************
'* Backup a DTS Package(s) From a list file
'************************************************************************
'* Author:
'* Azzam Alkadi
'* RWE Npower
'* Database Services
'* Leed, England
'* 26/01/2005
'* -------------------------------------------------------------------------------------------------
'* Description:
'* - This script will backup DTS package(s) to a .dts file(s). Passing parameters from the command line
'*   to connect and backup all or one package.
'* -------------------------------------------------------------------------------------------------
'* Useage:
'* 1. Run the script from a command prompt and enter parameters -SServerName -UUserName -PPassword -FBackupFolder
'*    -DDTSPackageName/All -LLogFile.
'* 2. If UserName and Password is missing , a Trusted Connection is used. You may backup one or all DTS packages
'*     using -D switch and passing either PackageName or All.
'* 3. Wait for the script to complete. You will get a messege prompt at the end.
'* 4. Check Log file and backup files.
'*-------------------------------------------------------------------------------------
'* Debug Note:
'* - This script can be used for attended and unnattended execution. A log file will be
'*   created at each run.
'* - Edit as .vbs file in, and *debug* scripts in the Microsoft Script Editor.
'************************************************************************

Dim intSpostion
Dim intUPostion
Dim intPPostion
Dim intFPostion
Dim intDPostion
Dim intLPostion
Dim StrInput
    
    On Error Resume Next

   strInput = InputBox("Enter Parameters (Example: -SServerName -UUserName -PPassword -FBackupFolder -DDTSPackageName/All -LLogFile -LLogFile." & vbCrLf & _
"If UserName and Password not supplied a Trusted Connection is Used. You may enter a PackageName or use All.")  
   'Check to see if parameters have been given
    If strInput <> "" Or strInput <> " " Then
        If InStr(1, strInput, "-S") <> 0 And InStr(1, strInput, "-U") <> 0 And InStr(1, strInput, "-P") <> 0 And InStr(1, strInput, "-F") <> 0 And InStr(1, strInput, "-D") <> 0 And InStr(1, strInput, "-L") <> 0 Then
        
            intSpostion = InStr(1, strInput, "-S")
            intUPostion = InStr(1, strInput, "-U")
            intPPostion = InStr(1, strInput, "-P")
            intFPostion = InStr(1, strInput, "-F")
            intDPostion = InStr(1, strInput, "-D")
            intLPostion = InStr(1, strInput, "-L")
            
            strServerName = Mid(strInput, intSpostion + 2, intUPostion - 4)
            strUserName = Mid(strInput, intUPostion + 2, intPPostion - (intUPostion + 3))
            strPassword = Mid(strInput, intPPostion + 2, intFPostion - (intPPostion + 3))
            strBackupFolder = Mid(strInput, intFPostion + 2, intDPostion - (intFPostion + 3))
            strPackageName = Mid(strInput, intDPostion + 2, intLPostion - (intDPostion + 3))
            strLogFile = Mid(strInput, intLPostion + 2)
            
            If strUserName = "" And strPassword = "" Then
                bltrusted = True
            Else
                bltrusted = False
            End If
            ' Create Backup File
            If Not CreateBackup Then
                MsgBox "Failed To Backup DTS Package(s), Check Log File For Error."
            Else
                MsgBox "DTs Package(s) Backup Completed, Check Log File For Error."
            End If
        Else
            MsgBox "One or more missing Parameters." & vbCrLf & "Usage:  -SServerName -UUserName -PPassword -FBackupFolder -DDTSPackageName/All -LLogFile."
        End If
    Else
        MsgBox "Missing Parameters." & vbCrLf & "Usage:  -SServerName -UUserName -PPassword -FBackupFolder -DDTSPackageName/All -LLogFile."
    End If
   
'**************************************
'* Create Backups
'**************************************
Function CreateBackup()
    
    On Error Resume Next
    
    Dim fso 'As new Scripting.FileSystemObject
    Dim dtspkg 'As new dts.appliction
    Dim dtspkg2 'As New dts.Package2
    Dim loLogFile 'As TextStream
    Dim dts 'As dts.PackageInfo
    Dim DTspkgs 'As dts.PackageInfos
    Dim pkgServer 'As dts.PackageSQLServer
    Const FileExtension = ".dts"
    CreateBackup = True
    
    ' Get File System and Package
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set loLogFile = fso.OpenTextFile(strLogFile, 2, True)
    Set dtspkg = CreateObject("dts.Application")
    Set dtspkg2 = CreateObject("dts.Package2")
    
    If bltrusted Then
        If strPackageName <> "All" Then
            dtspkg2.LoadFromSQLServer strServerName, strUserName, strPassword, 256, "", "", "", strPackageName
            If Err.Number <> 0 Then
                loLogFile.WriteLine "Connection Error. " & Err.Description
                CreateBackup = False
            End If
            If CreateBackup = True Then
                If fso.FileExists(strBackupFolder & "\" & strPackageName & FileExtension) Then
                    fso.DeleteFile (strBackupFolder & "\" & strPackageName & FileExtension)
                End If
                dtspkg2.SaveToStorageFile strBackupFolder & "\" & strPackageName & FileExtension
                If Err.Number <> 0 Then
                    loLogFile.WriteLine "DTs Package " & """" & strPackageName & """" & " Failed Backup. " & Err.Description
                    CreateBackup = False
                Else
                    loLogFile.WriteLine "DTs Package " & """" & strPackageName & """" & " Backed up Successfully."
                End If
            End If
        Else
            Set pkgServer = dtspkg.GetPackageSQLServer(strServerName, strUserName, strPassword, 256)
            If Err.Number <> 0 Then
                loLogFile.WriteLine "Connection Error. " & Err.Description
                CreateBackup = False
            End If
            If CreateBackup = True Then
                Set DTspkgs = pkgServer.EnumPackageInfos("", True, "")
                Set dts = DTspkgs.Next
                Do Until DTspkgs.EOF
                    If fso.FileExists(strBackupFolder & "\" & dts.Name & FileExtension) Then
                        fso.DeleteFile (strBackupFolder & "\" & dts.Name & FileExtension)
                    End If
                    dtspkg2.LoadFromSQLServer strServerName, strUserName, strPassword, 256, "", "", "", dts.Name
                    dtspkg2.SaveToStorageFile strBackupFolder & "\" & dts.Name & FileExtension
                    If Err.Number <> 0 Then
                        loLogFile.WriteLine "DTs Package " & """" & dts.Name & """" & " Failed Backup. " & Err.Description
                    Else
                        loLogFile.WriteLine "DTs Package " & """" & dts.Name & """" & " Backed up Successfully."
                    End If
                    Set dts = DTspkgs.Next
                    Set dtspkg2 = Nothing
                    Set dtspkg2 = CreateObject("dts.Package2")
                Loop
            End If
        End If
    Else
        If strPackageName <> "All" Then
            dtspkg2.LoadFromSQLServer strServerName, strUserName, strPassword, 0, "", "", "", strPackageName
            If Err.Number <> 0 Then
                loLogFile.WriteLine "Connection Error. " & Err.Description
                CreateBackup = False
            End If
            If CreateBackup = True Then
                If fso.FileExists(strBackupFolder & "\" & strPackageName & FileExtension) Then
                    fso.DeleteFile (strBackupFolder & "\" & strPackageName & FileExtension)
                End If
                dtspkg2.SaveToStorageFile strBackupFolder & "\" & strPackageName & FileExtension
                If Err.Number <> 0 Then
                    loLogFile.WriteLine "DTs Package "" & "" & strPackageName & """" Failed Backup. " & Err.Description
                    CreateBackup = False
                Else
                    loLogFile.WriteLine "DTs Package "" & "" & strPackageName & """" Backed up Successfully."
                End If
            End If
        Else
            Set pkgServer = dtspkg.GetPackageSQLServer(strServerName, strUserName, strPassword, 0)
            If Err.Number <> 0 Then
                loLogFile.WriteLine "Connection Error. " & Err.Description
                CreateBackup = False
            End If
            If CreateBackup = True Then
                Set DTspkgs = pkgServer.EnumPackageInfos("", True, "")
                Set dts = DTspkgs.Next
                Do Until DTspkgs.EOF
                    If fso.FileExists(strBackupFolder & "\" & dts.Name & FileExtension) Then
                        fso.DeleteFile (strBackupFolder & "\" & dts.Name & FileExtension)
                    End If
                    dtspkg2.LoadFromSQLServer strServerName, strUserName, strPassword, 0, "", "", "", dts.Name
                    dtspkg2.SaveToStorageFile strBackupFolder & "\" & dts.Name & FileExtension
                    If Err.Number <> 0 Then
                        loLogFile.WriteLine "DTs Package " & """" & dts.Name & """" & " Failed Backup. " & Err.Description
                    Else
                        loLogFile.WriteLine "DTs Package " & """" & dts.Name & """" & " Backed up Successfully."
                    End If
                    Set dts = DTspkgs.Next
                    Set dtspkg2 = Nothing
                    Set dtspkg2 = CreateObject("dts.Package2")
                Loop
            End If
        End If
    End If
    
    ' Destroy Objects
    Set fso = Nothing
    Set dtspkg = Nothing
    Set dtspkg2 = Nothing
    Set pkgServer = Nothing
    Set DTspkgs = Nothing
    Set dts = Nothing
    Set loLogFile = Nothing
End Function