Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Public Sub ReturnExitCode(intExitCode As Long)
   ExitProcess intExitCode
End Sub
Public Sub Main()
   Call InitializeLogFile
   Call InitializeFileList
   a_strArgs = Split(Command$, " ")
   Call SavePackagesAsStorageFile
End Sub
Public Sub SavePackagesAsStorageFile()
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

On Error GoTo ErrorHandler
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

Set fsFileSystem = CreateObject("Scripting.FileSystemObject")
Set fsDTSFileList = fsFileSystem.CreateTextFile(cnstFileList, True)
Set fsLogFile = fsFileSystem.CreateTextFile(cnstLogFile, True)

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)
   Call dtsPackage.SaveToStorageFile("C:\DTS\" & dtsPackageInfo.Name
& ".dts")
   WriteMsgToFile ("C:\DTS\" & dtsPackageInfo.Name & ".dts")
   LogMsgToFile ("Saved DTS package " & dtsPackage.Name & " _
     as " & "C:\DTS\" & dtsPackageInfo.Name &
".dts")
   Set dtsPackage = Nothing
   Set dtsPackageInfo = dtsPackageInfos.Next
Wend
Set dtsPackageInfos = Nothing
Set dtsPackageSQLServer = Nothing
Set dtsApplication = Nothing
fsDTSFileList.Close
fsLogFile.Close
Set fsDTSFileList = Nothing
Set fsLogFile = Nothing
Set fsFileSystem = Nothing
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 InitializeFileList()
       Set fsFileSystem = CreateObject("Scripting.FileSystemObject")
       Set fsDTSFileList = fsFileSystem.CreateTextFile(cnstFileList, True)
       fsDTSFileList.Close
       Set fsDTSFileList = 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
' Create the File System Object
Set objFile = CreateObject("Scripting.FileSystemObject")
If Trim(strFileName) <> "" Then
' Note If..Exists. Then, Else ... End If construction
   If objFile.FileExists(strFileName) Then
     bolFileExists = True
   Else
     bolFileExists = False
   End If
Else
   bolFileExists = False
End If
FileExists = bolFileExists
Set objFile = Nothing
End Function