modapi32.bas

vb+sql 用于公交点钞结算和报表结合的相关软件

Attribute VB_Name = "modApi32"
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public strCollection As String '连接 ZZ_AMC
Public zzstrCollection As String '连接 ZZ_BUS_IC
Public cnn As New ADODB.Connection '连接 ZZ_AMC
Public zzcnn As New ADODB.Connection '连接 ZZ_BUS_IC
Public clsDaivd As New DavidClass.clsConfig
Public cCheckOP As String
Public cCheckName As String
Public ViewFlag As Integer '报表性质
Public CheckFlag As Integer '是否有车辆重复
Public goPackageOld As New DTS.Package
Public goPackage As DTS.Package2

Public Sub ExecuteDTS()
        Set goPackage = goPackageOld

        goPackage.Name = "Input_Countbill_log"
        goPackage.WriteCompletionStatusToNTEventLog = False
        goPackage.FailOnError = False
        goPackage.PackagePriorityClass = 2
        goPackage.MaxConcurrentSteps = 4
        goPackage.LineageOptions = 0
        goPackage.UseTransaction = True
        goPackage.TransactionIsolationLevel = 4096
        goPackage.AutoCommitTransaction = True
        goPackage.RepositoryMetadataOptions = 0
        goPackage.UseOLEDBServiceComponents = True
        goPackage.LogToSQLServer = False
        goPackage.LogServerFlags = 0
        goPackage.FailPackageOnLogFailure = False
        goPackage.ExplicitGlobalVariables = False
        goPackage.PackageType = 0
        


'---------------------------------------------------------------------------
' create package connection information
'---------------------------------------------------------------------------

Dim oConnection As DTS.Connection2

'------------- a new connection defined below.
'For security purposes, the password is never scripted

Set oConnection = goPackage.Connections.New("SQLOLEDB")

        oConnection.ConnectionProperties("Persist Security Info") = True
        oConnection.ConnectionProperties("User ID") = "JZBUS"
        oConnection.ConnectionProperties("Initial Catalog") = "zz_amc"
        oConnection.ConnectionProperties("Data Source") = "clusrv"
        oConnection.ConnectionProperties("Application Name") = "DTS 设计器"
        
        oConnection.Name = "Microsoft OLE DB Provider for SQL Server"
        oConnection.ID = 1
        oConnection.Reusable = True
        oConnection.ConnectImmediate = False
        oConnection.DataSource = "clusrv"
        oConnection.UserID = "JZBUS"
        oConnection.ConnectionTimeout = 60
        oConnection.Catalog = "zz_amc"
        oConnection.UseTrustedConnection = False
        oConnection.UseDSL = False
        
        'If you have a password for this connection, please uncomment and add your password below.
        oConnection.Password = "EGMCCZHONGYIN"

goPackage.Connections.Add oConnection
Set oConnection = Nothing

'------------- a new connection defined below.
'For security purposes, the password is never scripted

Set oConnection = goPackage.Connections.New("SQLOLEDB")

        oConnection.ConnectionProperties("Persist Security Info") = True
        oConnection.ConnectionProperties("User ID") = "JZBUS"
        oConnection.ConnectionProperties("Initial Catalog") = "ZZ_BUS_IC"
        oConnection.ConnectionProperties("Data Source") = "clusrv"
        oConnection.ConnectionProperties("Application Name") = "DTS 设计器"
        
        oConnection.Name = "Microsoft OLE DB Provider for SQL Server 2"
        oConnection.ID = 2
        oConnection.Reusable = True
        oConnection.ConnectImmediate = False
        oConnection.DataSource = "clusrv"
        oConnection.UserID = "JZBUS"
        oConnection.ConnectionTimeout = 60
        oConnection.Catalog = "ZZ_BUS_IC"
        oConnection.UseTrustedConnection = False
        oConnection.UseDSL = False
        
        'If you have a password for this connection, please uncomment and add your password below.
        oConnection.Password = "EGMCCZHONGYIN"

goPackage.Connections.Add oConnection
Set oConnection = Nothing

'---------------------------------------------------------------------------
' create package steps information
'---------------------------------------------------------------------------

Dim oStep As DTS.Step2
Dim oPrecConstraint As DTS.PrecedenceConstraint

'------------- a new step defined below

Set oStep = goPackage.Steps.New

        oStep.Name = "DTSStep_DTSDataPumpTask_1"
        oStep.Description = "转换数据任务: 未定义"
        oStep.ExecutionStatus = 1
        oStep.TaskName = "DTSTask_DTSDataPumpTask_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
        
goPackage.Steps.Add oStep
Set oStep = Nothing

'------------- a new step defined below

Set oStep = goPackage.Steps.New

        oStep.Name = "DTSStep_DTSExecuteSQLTask_1"
        oStep.Description = "START"
        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
        
goPackage.Steps.Add oStep
Set oStep = Nothing

'------------- a new step defined below

Set oStep = goPackage.Steps.New

        oStep.Name = "DTSStep_DTSExecuteSQLTask_2"
        oStep.Description = "END"
        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
        
goPackage.Steps.Add oStep
Set oStep = Nothing

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

Set oStep = goPackage.Steps("DTSStep_DTSDataPumpTask_1")
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

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

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

'---------------------------------------------------------------------------
' create package tasks information
'---------------------------------------------------------------------------

'------------- call Task_Sub1 for task DTSTask_DTSDataPumpTask_1 (转换数据任务: 未定义)
Call Task_Sub1(goPackage)

'------------- call Task_Sub2 for task DTSTask_DTSExecuteSQLTask_1 (START)
Call Task_Sub2(goPackage)

'------------- call Task_Sub3 for task DTSTask_DTSExecuteSQLTask_2 (END)
Call Task_Sub3(goPackage)

'---------------------------------------------------------------------------
' Save or execute package
'---------------------------------------------------------------------------

'goPackage.SaveToSQLServer "(local)", "sa", ""
goPackage.Execute
goPackage.UnInitialize
'to save a package instead of executing it, comment out the executing package line above and uncomment the saving package line
Set goPackage = Nothing

Set goPackageOld = Nothing

End Sub


'------------- define Task_Sub1 for task DTSTask_DTSDataPumpTask_1 (转换数据任务: 未定义)
Public Sub Task_Sub1(ByVal goPackage As Object)

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

Dim oCustomTask1 As DTS.DataPumpTask2
Set oTask = goPackage.Tasks.New("DTSDataPumpTask")
Set oCustomTask1 = oTask.CustomTask

        oCustomTask1.Name = "DTSTask_DTSDataPumpTask_1"
        oCustomTask1.Description = "转换数据任务: 未定义"
        oCustomTask1.SourceConnectionID = 1
        oCustomTask1.SourceSQLStatement = "SELECT [OP_NO],[BUS_NO],[LINE_NO],[DEPT_NO],[TOTAL_MONEY],[INPUT_DATE],[TRANFFICSUM],0 AS UPDATE_FLAG,0 AS IS_SEND,[GROUP_NO] FROM [ZZ_AMC].[DBO].[ZY_COUNTBILL_LOG]" & vbCrLf
        oCustomTask1.SourceSQLStatement = oCustomTask1.SourceSQLStatement & "WHERE IS_SEND=1"
        oCustomTask1.DestinationConnectionID = 2
        oCustomTask1.DestinationObjectName = "[ZZ_BUS_IC].[dbo].[ZY_COUNTBILL_LOG]"
        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 oCustomTask1_Trans_Sub1(oCustomTask1)
                
                
goPackage.Tasks.Add oTask
Set oCustomTask1 = Nothing
Set oTask = Nothing

End Sub

Public Sub oCustomTask1_Trans_Sub1(ByVal oCustomTask1 As Object)

        Dim oTransformation As DTS.Transformation2
        Dim oTransProps As DTS.Properties
        Dim oColumn As DTS.Column
        Set oTransformation = oCustomTask1.Transformations.New("DTSPump.DataPumpTransformCopy")
                oTransformation.Name = "DTSTransformation__1"
                oTransformation.TransformFlags = 63
                oTransformation.ForceSourceBlobsBuffered = 0
                oTransformation.ForceBlobsInMemory = False
                oTransformation.InMemoryBlobSize = 1048576
                oTransformation.TransformPhases = 4
                
                Set oColumn = oTransformation.SourceColumns.New("GROUP_NO", 1)
                        oColumn.Name = "GROUP_NO"
                        oColumn.Ordinal = 1
                        oColumn.Flags = 32792
                        oColumn.Size = 0
                        oColumn.DataType = 131
                        oColumn.Precision = 8
                        oColumn.NumericScale = 0
                        oColumn.Nullable = False
                        
                oTransformation.SourceColumns.Add oColumn
                Set oColumn = Nothing

                Set oColumn = oTransformation.SourceColumns.New("IS_SEND", 2)
                        oColumn.Name = "IS_SEND"
                        oColumn.Ordinal = 2
                        oColumn.Flags = 16
                        oColumn.Size = 0
                        oColumn.DataType = 3
                        oColumn.Precision = 0
                        oColumn.NumericScale = 0
                        oColumn.Nullable = False