Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Public Sub ReturnExitCode(intExitCode As Long)
   ExitProcess intExitCode
End Sub
Sub  Main()
   a_strArgs = Split(Command$, " ")
   Call SaveStorageFilesToServer
End Sub
Public Sub SaveStorageFilesToServer()
Dim dtsApplication                  As DTS.Application
Dim dtsPackageSQLServer             As DTS.PackageSQLServer
Dim dtsPackageInfos                 As DTS.PackageInfos
Dim dtsPackageInfo                  As DTS.PackageInfo
Dim dtsPackage                      As DTS.Package
Dim strFullPath                     As String
Dim blnPackageExists                As Boolean
Dim conInPack                       As Object
Dim tskInPack                       As Object
Dim dtsTaskProperty                 As Object
Dim strInfo                         As Variant

On Error GoTo ErrorHandler
blnPackageExists = False
Set fsFileSystem = CreateObject("Scripting.FileSystemObject")
Set fsDTSFileList = fsFileSystem.OpenTextFile(cnstFileList, 1)
   Do While Not fsDTSFileList.AtEndOfStream
      strFullPath = Trim(fsDTSFileList.ReadLine)
      If FileExists(cnstFileList) Then
         Set dtsPackage = New DTS.Package
         Call dtsPackage.LoadFromStorageFile(strFullPath, "")
         Call dtsPackage.SaveToSQLServer(a_strArgs(0), a_strArgs(1), a_strArgs(2))
         Set dtsPackage = Nothing
         blnPackageExists = True
      Else
          LogMsgToFile ("******** Warning: The file " & strFullPath & _
                     " listed in the filelist doesnot exist. ********")
      End If
   Loop
Set fsDTSFileList = Nothing
Set dtsPackage = Nothing

'Now we have to loop through the Package and set the connection objects properties
' to the new database credentials.

Set dtsApplication = New DTS.Application
Set dtsPackageSQLServer = dtsApplication.GetPackageSQLServer(a_strArgs(0), _
                        a_strArgs(1), a_strArgs(2), DTSSQLStgFlag_Default)
Set dtsPackageInfos = dtsPackageSQLServer.EnumPackageInfos("", True, "")
Set dtsPackageInfo = dtsPackageInfos.Next

While Not dtsPackageInfos.EOF
   Set dtsPackage = New DTS.Package
   Call dtsPackage.LoadFromSQLServer(a_strArgs(0), a_strArgs(1), a_strArgs(2), _
          DTSSQLStgFlag_Default, , dtsPackageInfo.PackageID, dtsPackageInfo.VersionID, _
          dtsPackageInfo.Name)
   For Each conInPack In dtsPackage.Connections
       If conInPack.ProviderID = "SQLOLEDB" Then
          conInPack.DataSource = a_strArgs(0)
          conInPack.UserID = a_strArgs(1)
          conInPack.Password = a_strArgs(2)
       End If
   Next
   Call dtsPackage.SaveToSQLServer(a_strArgs(0), a_strArgs(1), a_strArgs(2),
DTSSQLStgFlag_Default)
   Set dtsPackage = Nothing
   Set dtsPackageInfo = dtsPackageInfos.Next
Wend
Set conInPack = Nothing
Set dtsPackage = Nothing
Set dtsPackageInfo = Nothing
'Set the embedded package Collection to new ID and Connection Properties.
Set dtsPackageInfos = dtsPackageSQLServer.EnumPackageInfos("", True,
"")
Set dtsPackageInfo = dtsPackageInfos.Next

While Not dtsPackageInfos.EOF
   Set dtsPackage = New DTS.Package
   Call dtsPackage.LoadFromSQLServer(a_strArgs(0), a_strArgs(1), a_strArgs(2), _
           DTSSQLStgFlag_Default, , dtsPackageInfo.PackageID, dtsPackageInfo.VersionID, _
           dtsPackageInfo.Name)
   For Each tskInPack In dtsPackage.Tasks
      If tskInPack.CustomTaskID = "DTSExecutePackageTask" Then
         'MsgBox tskInPack.CustomTaskID
         strInfo = GetPackageIDAndLatestVersionID(tskInPack.Properties("PackageName").Value, _
            a_strArgs(0), a_strArgs(1), a_strArgs(2))
         For Each dtsTaskProperty In tskInPack.Properties
            If dtsTaskProperty.Name = "ServerName" Then
               dtsTaskProperty.Value = a_strArgs(0)
            End If

            If dtsTaskProperty.Name = "ServerUserName" Then
               If dtsTaskProperty.Value <> "" Then
                 dtsTaskProperty.Value = a_strArgs(1)
               End If
            End If
            If dtsTaskProperty.Name = "ServerPassword" Then
               If dtsTaskProperty.Value <> "" Then
                  dtsTaskProperty.Value = a_strArgs(2)
               End If
            End If
            If dtsTaskProperty.Name = "PackageID" Then
               dtsTaskProperty.Value = strInfo(1)
            End If
            If dtsTaskProperty.Name = "VersionID" Then
               dtsTaskProperty.Value = strInfo(0)
            End If
        Next
     End If
   Next
   Call dtsPackage.SaveToSQLServer(a_strArgs(0), a_strArgs(1), a_strArgs(2), _
           DTSSQLStgFlag_Default)
   Set dtsPackage = Nothing
   Set dtsPackageInfo = dtsPackageInfos.Next
Wend
Exit Sub
ErrorHandler:
   Set dtsApplication = Nothing
   Set dtsPackageSQLServer = Nothing
   Set dtsPackageInfos = Nothing
   Set dtsPackageInfo = Nothing
   Set dtsPackage = Nothing
   ReturnExitCode Err.Number
End Sub
Public Sub InitializeLogFile()
   Set fsFileSystem = CreateObject("Scripting.FileSystemObject")
   Set fsLogFile = fsFileSystem.CreateTextFile(cnstLogFile, True)
   fsLogFile.Close
   Set fsLogFile = Nothing
   Set fsFileSystem = Nothing
End Sub
Public Sub WriteMsgToFile(strMsg As String)
   fsDTSFileList.WriteLine " " & strMsg
End Sub
Public Sub LogMsgToFile(strMsg As String)
   fsLogFile.WriteLine " " & strMsg
End Sub
Public Function FileExists(strFileName As String) As Boolean
Dim objFile                             As Object
Dim bolFileExists                       As Boolean

bolFileExists = False
Set objFile = CreateObject("Scripting.FileSystemObject")
If Trim(strFileName) <> "" Then
   If objFile.FileExists(strFileName) Then
      bolFileExists = True
   Else
      bolFileExists = False
   End If
Else
   bolFileExists = False
End If
FileExists = bolFileExists
Set objFile = Nothing
End Function
Public Function GetPackageIDAndLatestVersionID(strPackageName As String, _
         strServerName As String, strLogin As String, strPassword As String) As Variant
Dim dtsPackage                      As DTS.Package
Dim strFullPath                     As String
Dim strInfo(2)                      As String

Set dtsPackage = New DTS.Package
Call dtsPackage.LoadFromSQLServer(strServerName, strLogin, strPassword, _)
        DTSSQLStgFlag_Default, , , , strPackageName)
strInfo(0) = dtsPackage.VersionID
strInfo(1) = dtsPackage.PackageID

GetPackageIDAndLatestVersionID = strInfo
Set dtsPackage = Nothing
End Function