Private Sub GenDTSPackage()
    Set oPackage = oPackageOld

    oPackage.Name = "OraToSql"
    oPackage.Description = "Oracle 数据库转换为 SQL Server 数据库 "
    oPackage.WriteCompletionStatusToNTEventLog = False
    oPackage.FailOnError = False
    oPackage.PackagePriorityClass = 2
    oPackage.MaxConcurrentSteps = 4
    oPackage.LineageOptions = 0
    oPackage.UseTransaction = True
    oPackage.TransactionIsolationLevel = 4096
    oPackage.AutoCommitTransaction = True
    oPackage.RepositoryMetadataOptions = 0
    oPackage.UseOLEDBServiceComponents = True
    oPackage.LogToSQLServer = False
    oPackage.LogServerFlags = 0
    oPackage.FailPackageOnLogFailure = False
    oPackage.ExplicitGlobalVariables = False
    oPackage.PackageType = 0
    
'---------------------------------------------------------------------------
'    Create Package Connection Information
'---------------------------------------------------------------------------

    Dim oConnection As DTS.Connection2

'-----------------------------------------------------------------------------------------------------
'   Create The Connection Link To Oracle Server
'-----------------------------------------------------------------------------------------------------

    Set oConnection = oPackage.Connections.New("OraOLEDB.Oracle")

    oConnection.ConnectionProperties("Persist Security Info") = True
    oConnection.ConnectionProperties("User ID") = Text2(0).Text
    oConnection.ConnectionProperties("Data Source") = Text1(0).Text
    oConnection.ConnectionProperties("Window Handle") = 0
    oConnection.ConnectionProperties("Locale Identifier") = 2052
    oConnection.ConnectionProperties("Prompt") = 2
    oConnection.ConnectionProperties("OLE DB Services") = -1
    
    oConnection.Name = "Oracle Provider for OLE DB"
    oConnection.ID = 1
    oConnection.Reusable = True
    oConnection.ConnectImmediate = False
    oConnection.DataSource = Text1(0).Text
    oConnection.UserID = Text2(0).Text
    oConnection.ConnectionTimeout = 60
    oConnection.UseTrustedConnection = False
    oConnection.UseDSL = False
    oConnection.Password = Text3(0).Text

    oPackage.Connections.Add oConnection
    Set oConnection = Nothing

'------------------------------------------------------------------------------------------------------
'   Create the Second Connection Link To SQL Server
'------------------------------------------------------------------------------------------------------
    Set oConnection = oPackage.Connections.New("SQLOLEDB")

    oConnection.ConnectionProperties("Integrated Security") = "SSPI"
    oConnection.ConnectionProperties("Persist Security Info") = True
    oConnection.ConnectionProperties("Initial Catalog") = Text1(1).Text
    oConnection.ConnectionProperties("Data Source") = Text4.Text
    oConnection.ConnectionProperties("Application Name") = "DTS 设计器"
    
    oConnection.Name = "Microsoft OLE DB Provider for SQL Server"
    oConnection.ID = 2
    oConnection.Reusable = True
    oConnection.ConnectImmediate = False
    oConnection.DataSource = Text4.Text
    oConnection.ConnectionTimeout = 60
    oConnection.Catalog = Text1(1).Text
    oConnection.UseTrustedConnection = False
    oConnection.UseDSL = False
    oConnection.UserID = Text2(1).Text
    oConnection.Password = Text3(1).Text

    oPackage.Connections.Add oConnection
    Set oConnection = Nothing

'---------------------------------------------------------------------------
'   Create DTSPackage Steps Information
'---------------------------------------------------------------------------
    Dim lnLoop As Integer
    Dim tmpStr As String
    
    Dim oStep As DTS.Step2
    Dim oPrecConstraint As DTS.PrecedenceConstraint
    For lnLoop = 0 To List2.ListCount - 1
        
    
        Set oStep = oPackage.Steps.New
      
        oStep.Name = "DTSStep_DTSDataPumpTask_" & lnLoop
        oStep.Description = "DTS Task " & lnLoop
        oStep.ExecutionStatus = 1
        oStep.TaskName = "DTSTask_DTSDataPumpTask_" & lnLoop
        oStep.CommitSuccess = False
        oStep.RollbackFailure = True
        oStep.ScriptLanguage = "VBScript"
        oStep.AddGlobalVariables = True
        oStep.RelativePriority = 3
        oStep.CloseConnection = False
        oStep.ExecuteInMainThread = False
        oStep.IsPackageDSORowset = False
        oStep.JoinTransactionIfPresent = False
        oStep.DisableStep = False
        oStep.FailPackageOnError = False
    
        oPackage.Steps.Add oStep
        Set oStep = Nothing
        
'--------------------------------------------------------------------------------------------------
'   Create Package Tasks Information
'--------------------------------------------------------------------------------------------------
        tmpStr = List2.List(lnLoop)
                
        Call Task_Sub(oPackage, Mid(tmpStr, 1, InStr(1, tmpStr, ".", vbTextCompare) - 1), Mid(tmpStr, _
                                                    InStr(1, tmpStr, ".", vbTextCompare) + 1), lnLoop)
    Next
    Call preTaskTable
'-------------------------------------------------------------------------------------------------
'  Add SQLExecute Task:Drop Table ---> Create Table  --> DTSStep_DTSDataPumpTask
'-------------------------------------------------------------------------------------------------
    Set oStep = oPackage.Steps.New

    oStep.Name = "DTSStep_DTSExecuteSQLTask_1"
    oStep.Description = "Drop Table"
    oStep.ExecutionStatus = 1
    oStep.TaskName = "DTSTask_DTSExecuteSQLTask_1"
    oStep.CommitSuccess = False
    oStep.RollbackFailure = False
    oStep.ScriptLanguage = "VBScript"
    oStep.AddGlobalVariables = True
    oStep.RelativePriority = 3
    oStep.CloseConnection = False
    oStep.ExecuteInMainThread = False
    oStep.IsPackageDSORowset = False
    oStep.JoinTransactionIfPresent = False
    oStep.DisableStep = False
    oStep.FailPackageOnError = False
    
    oPackage.Steps.Add oStep
    Set oStep = Nothing


    Set oStep = oPackage.Steps.New

    oStep.Name = "DTSStep_DTSExecuteSQLTask_2"
    oStep.Description = "Create Table"
    oStep.ExecutionStatus = 1
    oStep.TaskName = "DTSTask_DTSExecuteSQLTask_2"
    oStep.CommitSuccess = False
    oStep.RollbackFailure = False
    oStep.ScriptLanguage = "VBScript"
    oStep.AddGlobalVariables = True
    oStep.RelativePriority = 3
    oStep.CloseConnection = False
    oStep.ExecuteInMainThread = False
    oStep.IsPackageDSORowset = False
    oStep.JoinTransactionIfPresent = False
    oStep.DisableStep = False
    oStep.FailPackageOnError = False
    
    oPackage.Steps.Add oStep
    Set oStep = Nothing
    
    Set oStep = oPackage.Steps("DTSStep_DTSDataPumpTask_0")
    Set oPrecConstraint = oStep.PrecedenceConstraints.New("DTSStep_DTSExecuteSQLTask_2")
    oPrecConstraint.StepName = "DTSStep_DTSExecuteSQLTask_2"
    oPrecConstraint.PrecedenceBasis = 0
    oPrecConstraint.Value = 4
    
    oStep.PrecedenceConstraints.Add oPrecConstraint
    Set oPrecConstraint = Nothing

'------------- a precedence constraint for steps defined below

    Set oStep = oPackage.Steps("DTSStep_DTSExecuteSQLTask_2")
    Set oPrecConstraint = oStep.PrecedenceConstraints.New("DTSStep_DTSExecuteSQLTask_1")
    oPrecConstraint.StepName = "DTSStep_DTSExecuteSQLTask_1"
    oPrecConstraint.PrecedenceBasis = 0
    oPrecConstraint.Value = 4
    
    oStep.PrecedenceConstraints.Add oPrecConstraint
    Set oPrecConstraint = Nothing


    For lnLoop = 1 To List2.ListCount - 1
        Set oStep = oPackage.Steps("DTSStep_DTSDataPumpTask_" & lnLoop)
        Set oPrecConstraint = oStep.PrecedenceConstraints.New("DTSStep_DTSDataPumpTask_" & (lnLoop - 1))
        oPrecConstraint.StepName = "DTSStep_DTSDataPumpTask_" & (lnLoop - 1)
        oPrecConstraint.PrecedenceBasis = 0
        oPrecConstraint.Value = 4
    
        oStep.PrecedenceConstraints.Add oPrecConstraint
        Set oPrecConstraint = Nothing
    Next
'---------------------------------------------------------------------------
'   Save And DTSPackage In SQLServer
'---------------------------------------------------------------------------
    oPackage.SaveToSQLServer Text4.Text, Text2(1).Text, Text3(1).Text
    oPackage.UnInitialize
    Set oPackage = Nothing
    Set oPackageOld = Nothing
End Sub
'-----------------------------------------------------------------------------------------------------
'   Create Step Drop and Create Table
'-----------------------------------------------------------------------------------------------------
'------------- define Task_Sub2 for task DTSTask_DTSExecuteSQLTask_1 (drop)
Private Sub preTaskTable()

    Dim rst As New ADODB.Recordset
    Dim strSQL As String
    Dim tmpStr As String
    Dim lnLoop As Integer
    Dim strTask1, strTask2 As String
    strTask1 = ""
    strTask2 = ""
    For lnLoop = 0 To List2.ListCount - 1
       tmpStr = List2.List(lnLoop)
       strSQL = "SELECT COLUMN_ID, COLUMN_NAME, DATA_TYPE, DATA_LENGTH, DATA_PRECISION, DATA_SCALE "
       strSQL = strSQL & "FROM SYS.ALL_TAB_COLUMNS WHERE TABLE_NAME="
       strSQL = strSQL & "'" & Mid(tmpStr, InStr(1, tmpStr, ".", vbTextCompare) + 1) & "'"
       strSQL = strSQL & " and OWNER='" & Mid(tmpStr, 1, InStr(1, tmpStr, ".", vbTextCompare) - 1) & "'"
       With rst
          .Source = strSQL
          .ActiveConnection = oraCon
          .CursorType = adOpenKeyset
          .LockType = adLockOptimistic
          .Open
       End With
       strTask2 = strTask2 & SQLCreateTable(rst, Mid(tmpStr, InStr(1, tmpStr, ".", _
                                                                       vbTextCompare) + 1))
                                                                       
       strTask1 = strTask1 & "DROP TABLE " & Mid(tmpStr, InStr(1, tmpStr, ".", vbTextCompare) + 1) & vbCrLf
       
       rst.Close
    Next
    
    
    Dim oTask As DTS.Task
    Dim oLookup As DTS.Lookup

    Dim oCustomTask2 As DTS.ExecuteSQLTask2
    Set oTask = oPackage.Tasks.New("DTSExecuteSQLTask")
    oTask.Name = "DTSTask_DTSExecuteSQLTask_1"
    Set oCustomTask2 = oTask.CustomTask

    oCustomTask2.Name = "DTSTask_DTSExecuteSQLTask_1"
    oCustomTask2.Description = "Drop Table from SQL Server"
    oCustomTask2.SQLStatement = strTask1
    oCustomTask2.ConnectionID = 2
    oCustomTask2.CommandTimeout = 0
    oCustomTask2.OutputAsRecordset = False
    
    oPackage.Tasks.Add oTask
    Set oCustomTask2 = Nothing
    Set oTask = Nothing

    Set oTask = oPackage.Tasks.New("DTSExecuteSQLTask")
    oTask.Name = "DTSTask_DTSExecuteSQLTask_2"
    Set oCustomTask2 = oTask.CustomTask

    oCustomTask2.Name = "DTSTask_DTSExecuteSQLTask_2"
    oCustomTask2.Description = "Create Table in SQL Server"
    
    oCustomTask2.SQLStatement = strTask2
    oCustomTask2.ConnectionID = 2
    oCustomTask2.CommandTimeout = 0
    oCustomTask2.OutputAsRecordset = False
    
    oPackage.Tasks.Add oTask
    Set oCustomTask2 = Nothing
    Set oTask = Nothing


End Sub

'------------------------------------------------------------------------------------------------------
'            Function SQLCreateTable(rst As ADODB.Recordset, TableName As String)
'------------------------------------------------------------------------------------------------------

Private Function SQLCreateTable(rst As ADODB.Recordset, TableName As String)
   Dim strRtn As String
   Dim tmpStr, strType As String
   strRtn = "Create Table " & TableName & "(" & vbCrLf
   rst.MoveFirst
   Do Until rst.EOF
       strRtn = strRtn & "    " & rst.Fields("COLUMN_NAME") & " "
       tmpStr = rst.Fields("DATA_TYPE")
       strType = tmpStr
       Select Case tmpStr
           Case "CHAR"
                 strType = "CHAR"
           Case "VARCHAR2"
                 If Val(rst.Fields("DATA_LENGTH")) < 8000 Then
                    strType = "VARCHAR"
                 Else
                    strType = "TEXT"
                 End If
           Case "LONG"
                 If Val(rst.Fields("DATA_LENGTH")) < 8000 Then
                    strType = "VARCHAR"
                 Else
                    strType = "TEXT"
                 End If
           Case "RAW"
                 If Val(rst.Fields("DATA_LENGTH")) < 8000 Then
                    strType = "VARBINARY"
                 Else
                    strType = "IMAGE"
                 End If
           Case "LONG RAW"
                 If Val(rst.Fields("DATA_LENGTH")) < 8000 Then
                    strType = "VARBINARY"
                 Else
                    strType = "IMAGE"
                 End If
           Case "NUMBER"
                 strType = "DECIMAL"
           Case "DATE"
                 strType = "DATETIME"
       End Select
      strRtn = strRtn & strType
      If strType <> "DATETIME" Then
         strRtn = strRtn & "("
         If Not IsNull(rst.Fields("DATA_PRECISION")) Then
            strRtn = strRtn & rst.Fields("DATA_PRECISION") & "," & rst.Fields("DATA_SCALE")
         Else
            strRtn = strRtn & rst.Fields("DATA_LENGTH")
         End If
         strRtn = strRtn & ")"
      End If
      rst.MoveNext
      If Not rst.EOF Then
         strRtn = strRtn & "," & vbCrLf
      End If
   Loop
   strRtn = strRtn & ");" & vbCrLf
   SQLCreateTable = strRtn
End Function

'------------------------------------------------------------------------------------------------------
'   Create DTS Task for the TableName
'------------------------------------------------------------------------------------------------------


Public Sub Task_Sub(ByVal oPackage As Object, Owner As String, TableName As String, TaskNo As Integer)

    Dim oTask As DTS.Task
    Dim oLookup As DTS.Lookup

    Dim oCustomTask1 As DTS.DataPumpTask2
    Set oTask = oPackage.Tasks.New("DTSDataPumpTask")
    oTask.Name = "DTSTask_DTSDataPumpTask_" & TaskNo
    Set oCustomTask1 = oTask.CustomTask

    oCustomTask1.Name = "DTSTask_DTSDataPumpTask_" & TaskNo
    oCustomTask1.Description = "DTS Task " & TaskNo
    oCustomTask1.SourceConnectionID = 1
    oCustomTask1.SourceSQLStatement = "select * from " & Owner & "." & TableName
    oCustomTask1.DestinationConnectionID = 2
    oCustomTask1.DestinationObjectName = TableName
    oCustomTask1.ProgressRowCount = 1000
    oCustomTask1.MaximumErrorCount = 0
    oCustomTask1.FetchBufferSize = 1
    oCustomTask1.UseFastLoad = True
    oCustomTask1.InsertCommitSize = 0
    oCustomTask1.ExceptionFileColumnDelimiter = "|"
    oCustomTask1.ExceptionFileRowDelimiter = vbCrLf
    oCustomTask1.AllowIdentityInserts = False
    oCustomTask1.FirstRow = 0
    oCustomTask1.LastRow = 0
    oCustomTask1.FastLoadOptions = 2
    oCustomTask1.ExceptionFileOptions = 1
    oCustomTask1.DataPumpOptions = 0
    
    Call DTS_CustomTask(oCustomTask1)
    oPackage.Tasks.Add oTask
    Set oCustomTask1 = Nothing
    Set oTask = Nothing
End Sub
Private Sub DTS_CustomTask(oTask As DTS.DataPumpTask2)
    
    Dim oTransform As DTS.Transformation2
       
    Set oTransform = _
        oTask.Transformations.New("DTS.DataPumpTransformCopy")
    oTransform.Name = "CopyColumns"
    oTransform.TransformFlags = _
        DTSTransformFlag_AllowLosslessConversion
    oTask.Transformations.Add oTransform
    Set oTransform = Nothing
End Sub