Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 911
  • Last Modified:

DTS

I have written a VB code to transfer data from Excel to MSSQL 7, but nothing seems to happen, there are no errors...so i can't figure out why.

Here is the code:

Option Explicit

Public goPackage As New DTS.Package
Private num As Integer

Public Sub DTSInput(dbName As String)
goPackage.Name = "NewSiteData"
goPackage.Description = "DTS package description"
goPackage.WriteCompletionStatusToNTEventLog = True
goPackage.PackagePriorityClass = 2
goPackage.MaxConcurrentSteps = 4
goPackage.LineageOptions = 0
goPackage.UseTransaction = True
goPackage.TransactionIsolationLevel = 4096
goPackage.AutoCommitTransaction = True
goPackage.RepositoryMetadataOptions = 0
goPackage.UseOLEDBServiceComponents = True
             
Dim oConnection As DTS.Connection

On Error GoTo errorhandler

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

oConnection.ConnectionProperties("Initial Catalog") = dbName
oConnection.Name = "Connection"
oConnection.ID = 1
oConnection.Reusable = False
oConnection.ConnectImmediate = True
oConnection.ConnectionTimeout = 60
oConnection.Catalog = dbName
oConnection.UseTrustedConnection = True
oConnection.UseDSL = False
       
goPackage.Connections.Add oConnection
Set oConnection = Nothing

Set oConnection = goPackage.Connections.New("Microsoft.Jet.OLEDB.4.0")

oConnection.ConnectionProperties("Data Source") = "C:\E-qwik\Broker\sql\NewSiteData.xls"
oConnection.ConnectionProperties("Extended Properties") = "Excel 8.0;"
oConnection.Name = "NewSiteData.xls"
oConnection.ID = 2
oConnection.Reusable = False
oConnection.ConnectImmediate = True
oConnection.DataSource = "C:\E-qwik\Broker\sql\NewSiteData.xls"
oConnection.ConnectionTimeout = 60
oConnection.UseTrustedConnection = True
oConnection.UseDSL = False
       
goPackage.Connections.Add oConnection
Set oConnection = Nothing

Dim oStep As DTS.Step
Dim oPrecConstraint As DTS.PrecedenceConstraint

Set oStep = goPackage.Steps.New

oStep.Name = "DTSStep_DTSDataPumpTask_1"
oStep.Description = "Import data from Excel"
oStep.ExecutionStatus = 1
oStep.TaskName = "DTSTask_DTSDataPumpTask_1"
oStep.CommitSuccess = True
oStep.RollbackFailure = False
oStep.ScriptLanguage = "VBScript"
oStep.AddGlobalVariables = False
oStep.RelativePriority = 3
oStep.CloseConnection = True
oStep.ExecuteInMainThread = False
oStep.IsPackageDSORowset = False
oStep.JoinTransactionIfPresent = False
oStep.DisableStep = False
       
goPackage.Steps.Add oStep
Set oStep = Nothing

num = 1
InsertInfo goPackage, dbName
InsertStyle goPackage, dbName
InsertParty goPackage, dbName
InsertRelationShip goPackage, dbName

goPackage.Execute
goPackage.UnInitialize
Set goPackage = Nothing

MsgBox "Finish"
Exit Sub

errorhandler:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbCritical, "ERROR"

End Sub

Private Sub InsertInfo(ByVal goPackage As Object, dbName As String)

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

Dim oCustomTask As DTS.DataPumpTask
Dim cName As New Collection

On Error GoTo errorhandler

Set oTask = goPackage.Tasks.New("DTSDataPumpTask")
Set oCustomTask = oTask.CustomTask

oCustomTask.Name = "DTSTask_DTSDataPumpTask_1"
oCustomTask.Description = "Import data from Excel "
oCustomTask.SourceConnectionID = 1
oCustomTask.SourceObjectName = "Info$"
oCustomTask.DestinationConnectionID = 1
oCustomTask.DestinationObjectName = "[" & dbName & "].[dbo].[Info]"
oCustomTask.ProgressRowCount = 1000
oCustomTask.MaximumErrorCount = 0
oCustomTask.FetchBufferSize = 1
oCustomTask.UseFastLoad = False
oCustomTask.InsertCommitSize = 0
oCustomTask.ExceptionFileColumnDelimiter = "|"
oCustomTask.ExceptionFileRowDelimiter = vbCrLf
oCustomTask.AllowIdentityInserts = True
oCustomTask.FastLoadOptions = DTSFastLoad_Default
       
cName.Add ("Body")
cName.Add ("BodyFont")
cName.Add ("Tail")
cName.Add ("TailFont")
cName.Add ("Graphic")
cName.Add ("GraphicAlignment")
cName.Add ("Type")
cName.Add ("Link")

Dim x As Integer

For x = 1 To cName.Count
    Transformation oCustomTask, cName.Item(x)
    num = num + 1
Next
goPackage.Tasks.Add oTask
Set oCustomTask = Nothing
Set oTask = Nothing
Exit Sub

errorhandler:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbCritical, "ERROR"

End Sub
Private Sub InsertStyle(ByVal goPackage As Object, dbName As String)

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

Dim oCustomTask As DTS.DataPumpTask
Dim cName As New Collection

On Error GoTo errorhandler

Set oTask = goPackage.Tasks.New("DTSDataPumpTask")
Set oCustomTask = oTask.CustomTask

oCustomTask.Name = "DTSTask_DTSDataPumpTask_2"
oCustomTask.Description = "Import data from Excel "
oCustomTask.SourceConnectionID = 2
oCustomTask.SourceObjectName = "Style$"
oCustomTask.DestinationConnectionID = 2
oCustomTask.DestinationObjectName = "[" & dbName & "].[dbo].[Style]"
oCustomTask.ProgressRowCount = 1000
oCustomTask.MaximumErrorCount = 0
oCustomTask.FetchBufferSize = 1
oCustomTask.UseFastLoad = False
oCustomTask.InsertCommitSize = 0
oCustomTask.ExceptionFileColumnDelimiter = "|"
oCustomTask.ExceptionFileRowDelimiter = vbCrLf
oCustomTask.AllowIdentityInserts = False
oCustomTask.FastLoadOptions = DTSFastLoad_Default
       
cName.Add ("Identifier")
cName.Add ("Name")
cName.Add ("Attribute")
cName.Add ("Value")

Dim x As Integer

For x = 1 To cName.Count
    Transformation oCustomTask, cName.Item(x)
    num = num + 1
Next
goPackage.Tasks.Add oTask
Set oCustomTask = Nothing
Set oTask = Nothing
Exit Sub

errorhandler:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbCritical, "ERROR"

End Sub
Private Sub InsertParty(ByVal goPackage As Object, dbName As String)

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

Dim oCustomTask As DTS.DataPumpTask
Dim cName As New Collection

On Error GoTo errorhandler

Set oTask = goPackage.Tasks.New("DTSDataPumpTask")
Set oCustomTask = oTask.CustomTask

oCustomTask.Name = "DTSTask_DTSDataPumpTask_3"
oCustomTask.Description = "Import data from Excel "
oCustomTask.SourceConnectionID = 3
oCustomTask.SourceObjectName = "Party$"
oCustomTask.DestinationConnectionID = 3
oCustomTask.DestinationObjectName = "[" & dbName & "].[dbo].[Party]"
oCustomTask.ProgressRowCount = 1000
oCustomTask.MaximumErrorCount = 0
oCustomTask.FetchBufferSize = 1
oCustomTask.UseFastLoad = False
oCustomTask.InsertCommitSize = 0
oCustomTask.ExceptionFileColumnDelimiter = "|"
oCustomTask.ExceptionFileRowDelimiter = vbCrLf
oCustomTask.AllowIdentityInserts = True
oCustomTask.FastLoadOptions = DTSFastLoad_Default
       
cName.Add ("BusinessName")
cName.Add ("ABN")
cName.Add ("Roll")
cName.Add ("UserName")
cName.Add ("Password")
cName.Add ("Address")
cName.Add ("State")
cName.Add ("PostCode")
cName.Add ("Phone")
cName.Add ("Fax")
cName.Add ("Email")
cName.Add ("Active")
cName.Add ("Comment")
cName.Add ("MerchantID")

Dim x As Integer

For x = 1 To cName.Count
    Transformation oCustomTask, cName.Item(x)
    num = num + 1
Next
goPackage.Tasks.Add oTask
Set oCustomTask = Nothing
Set oTask = Nothing
Exit Sub

errorhandler:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbCritical, "ERROR"

End Sub
Private Sub InsertRelationShip(ByVal goPackage As Object, dbName As String)

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

Dim oCustomTask As DTS.DataPumpTask
Dim cName As New Collection

On Error GoTo errorhandler

Set oTask = goPackage.Tasks.New("DTSDataPumpTask")
Set oCustomTask = oTask.CustomTask

oCustomTask.Name = "DTSTask_DTSDataPumpTask_4"
oCustomTask.Description = "Import data from Excel "
oCustomTask.SourceConnectionID = 4
oCustomTask.SourceObjectName = "RelationShip$"
oCustomTask.DestinationConnectionID = 4
oCustomTask.DestinationObjectName = "[" & dbName & "].[dbo].[RelationShip]"
oCustomTask.ProgressRowCount = 1000
oCustomTask.MaximumErrorCount = 0
oCustomTask.FetchBufferSize = 1
oCustomTask.UseFastLoad = False
oCustomTask.InsertCommitSize = 0
oCustomTask.ExceptionFileColumnDelimiter = "|"
oCustomTask.ExceptionFileRowDelimiter = vbCrLf
oCustomTask.AllowIdentityInserts = False
oCustomTask.FastLoadOptions = DTSFastLoad_Default
       
cName.Add ("Identifier")
cName.Add ("fkConsumerParty")
cName.Add ("fkProducerParty")
cName.Add ("Discount")
cName.Add ("PaymentTerm")
cName.Add ("DeliveryCost")
cName.Add ("CreditLimit")

Dim x As Integer

For x = 1 To cName.Count
    Transformation oCustomTask, cName.Item(x)
    num = num + 1
Next
goPackage.Tasks.Add oTask
Set oCustomTask = Nothing
Set oTask = Nothing
Exit Sub

errorhandler:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbCritical, "ERROR"

End Sub

Public Sub Transformation(ByVal oCustomTask As Object, columnName As String)

Dim oTransformation As DTS.Transformation
Dim oColumn As DTS.Column

On Error GoTo errorhandler

Set oTransformation = oCustomTask.Transformations.New("DTS.DataPumpTransformCopy.1")

oTransformation.Name = "DTSTransformation__" & Str(num)
oTransformation.TransformFlags = 63
oTransformation.ForceSourceBlobsBuffered = 0
oTransformation.ForceBlobsInMemory = False
oTransformation.InMemoryBlobSize = 1048576
               
Set oColumn = oTransformation.SourceColumns.New(columnName, 1)
oColumn.Name = columnName

oTransformation.SourceColumns.Add oColumn
Set oColumn = Nothing

Set oColumn = oTransformation.DestinationColumns.New(columnName, 1)
oColumn.Name = columnName
                       
oTransformation.DestinationColumns.Add oColumn
Set oColumn = Nothing

oCustomTask.Transformations.Add oTransformation
Set oTransformation = Nothing
Exit Sub

errorhandler:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbCritical, "ERROR"

End Sub

0
RSpec
Asked:
RSpec
  • 3
  • 3
1 Solution
 
puranik_pCommented:
instead of writing it yourself, let MS SQL - DTS write the code for you.
Open up the DTS wizard and select Excel source, SQL destination etc.
now on final screen, instead of run immediately, select save package.
Now it will create a VBScipt file that you can use.
if you want more modifications, modify it.

all the best.
0
 
RSpecAuthor Commented:
Do i create the VBScript file by selecting the "file" option when saving? or should there be another option?
0
 
RSpecAuthor Commented:
Do i create the VBScript file by selecting the "file" option when saving? or should there be another option?
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
puranik_pCommented:
you can select Visual Basic File option from the save options.
it will save the file as Visual basic - .bas module.
now save it, open it, modify it.
0
 
RSpecAuthor Commented:
My save option doesn't seem to have the Visual Basic option, but thanks anyway....

Here are the points anyway, i'll do some more research on the suggests you have give me.
0
 
puranik_pCommented:
cheers!
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now