'*********************************************************************
' DTS Simple Package
'
' This program demonstrates how to create a simple DTS Package
' that copies the results of a query against the authors table using
' Visual Basic. In order to run this program, you must create an
' ODBC DSN for SQL Server 8.0 called SQL8 and make 'PUBS' the default
' database. You must run the CreateTable.SQL script to create the
' AuthorName table.
'*********************************************************************
Option Explicit
Private Sub Form_Load()
Dim oPackage As New DTS.Package
Dim oConnection As DTS.Connection
Dim oTask As DTS.Task
Dim oStep As DTS.Step
Dim oTransform As DTS.Transformation
Dim oPumpTask As DTS.DataPumpTask
Dim oProps As DTS.Properties
Dim iStatus As Boolean
Dim i As Integer
Dim strODBCdsn As String
Dim strUserName As String
Dim strPassword As String
On Error GoTo PackageError:
'******************************************************************
' Define Package Properties
'******************************************************************
oPackage.Name = "DTS Simple Package"
oPackage.Description = "Example of a simple DTS package"
'******************************************************************
' Define The Source Connection
'******************************************************************
strODBCdsn = "SQL8" 'Create a DSN called SQL8 or change name
strUserName = "sa" 'User name assume same source and dest
strPassword = "" 'with the same Password
Set oConnection = oPackage.Connections.New("MSDASQL")
oConnection.ID = 1
oConnection.DataSource = strODBCdsn
oConnection.UserID = strUserName
oConnection.Password = strPassword
oPackage.Connections.Add oConnection
Set oConnection = Nothing
'******************************************************************
' Define The Destination Connection
'******************************************************************
Set oConnection = oPackage.Connections.New("MSDASQL")
oConnection.ID = 2
oConnection.DataSource = strODBCdsn
oConnection.UserID = strUserName
oConnection.Password = strPassword
oPackage.Connections.Add oConnection
Set oConnection = Nothing
'******************************************************************
' Create Pump Task
'******************************************************************
Set oTask = oPackage.Tasks.New("DTSDataPumpTask")
oTask.Name = "Task1"
Set oPumpTask = oTask.CustomTask
oPumpTask.SourceConnectionID = 1
oPumpTask.SourceSQLStatement = "Select au_lname, au_fname from pubs..authors"
oPumpTask.DestinationConnectionID = 2
oPumpTask.DestinationObjectName = "AuthorName"
'******************************************************************
' Simple Copy
'******************************************************************
Set oTransform = oPumpTask.Transformations.New("DTS.DataPumpTransformCopy")
oTransform.Name = "Transform"
oTransform.TransformFlags = DTSTransformFlag_AllowLosslessConversion
oPumpTask.Transformations.Add oTransform
oPackage.Tasks.Add oTask
Set oTask = Nothing
Set oStep = oPackage.Steps.New
oStep.Name = "Step1"
oStep.TaskName = "Task1"
oPackage.Steps.Add oStep
Set oStep = Nothing
'******************************************************************
' Execute the Package
'******************************************************************
oPackage.Execute
'******************************************************************
' Check for Errors
'******************************************************************
Dim sMsg As String
sMsg = sAccumStepErrors(oPackage)
MsgBox "'" & oPackage.Description & _
IIf(Len(sMsg) > 0, "' error:" & vbCrLf & sMsg, "' successful")
Set oPackage = Nothing
Unload Me
Exit Sub
'******************************************************************
' Package Error Handler
'******************************************************************
PackageError:
MsgBox "'" & oPackage.Description & "' error: " & sErrorNumConv(Err.Number) & _
vbCrLf & Err.Description & vbCrLf & sAccumStepErrors(oPackage)
Unload Me
Exit Sub
End Sub
Private Function sAccumStepErrors(ByVal oPackage As DTS.Package) As String
'accumulate step error info into error message
Dim oStep As DTS.Step
Dim sMessage As String
Dim lErrNum As Long
Dim sDescr As String
Dim sSource As String
'----- look for steps completed and failed
For Each oStep In oPackage.Steps
If oStep.ExecutionStatus = DTSStepExecStat_Completed Then
If oStep.ExecutionResult = DTSStepExecResult_Failure Then
'----- get step error info, append to message
oStep.GetExecutionErrorInfo lErrNum, sSource, sDescr
sMessage = sMessage & vbCrLf & _
"Step '" & oStep.Name & "' failed, error: " & _
sErrorNumConv(lErrNum) & vbCrLf & sDescr & vbCrLf
End If
End If
Next
sAccumStepErrors = sMessage
End Function
Private Function sErrorNumConv(ByVal lErrNum As Long) As String
'convert error number into readable forms, hex, and decimal for low word
If lErrNum < 65536 And lErrNum > -65536 Then
sErrorNumConv = "x" & Hex(lErrNum) & " = " & CStr(lErrNum)
Else
sErrorNumConv = "x" & Hex(lErrNum) & " = x" & _
Hex(lErrNum And -65536) & " + " & CStr(lErrNum And 65535)
End If
End Function