Executing SQL DTS Package from Access



I'm trying to run a SQL DTS package that resides on my server. I'm using the
below code from a command button within my access file. This used to work a
few years back, but no loner will.

I'm using Office 2003 and have SQL 2005 developer edition on my pc and have
SQL 2000 (runs the SQL DTS package) on my Windows 2003 server. Also note, I
am using the proper MS DTSPackage Library within my References. My server
also has SQL 2000 Service Pack 4 installed.

Does anyone know if maybe Windows XP Service Pack 2 maybe causing it to
fail? Any other ideas?

CODE *************************

Dim oPKG As DTS.Package, oStep As DTS.step
Set oPKG = New DTS.Package

Dim sServer As String, sUsername As String, sPassword As String
Dim sPackageName As String, sMessage As String
Dim lErr As Long, sSource As String, sDesc As String

' Set Parameter Values
sServer = "myServer"
sUsername = "sa"
sPassword = "password"
sPackageName = "update_myDTS_job"

' Use mixed mode authentication
oPKG.LoadFromSQLServer sServer, sUsername, sPassword, _
DTSSQLStgFlag_Default, , , , sPackageName

' Set Exec on Main Thread
For Each oStep In oPKG.Steps
oStep.ExecuteInMainThread = True


' Get Status and Error Message
For Each oStep In oPKG.Steps
If oStep.ExecutionResult = DTSStepExecResult_Failure Then
oStep.GetExecutionErrorInfo lErr, sSource, sDesc
sMessage = sMessage & "Step """ & oStep.name & _
""" Failed" & vbCrLf & _
vbTab & "Error: " & lErr & vbCrLf & _
vbTab & "Source: " & sSource & vbCrLf & _
vbTab & "Description: " & sDesc & vbCrLf & vbCrLf
sMessage = sMessage & "Step """ & oStep.name & _
""" Succeeded" & vbCrLf & vbCrLf
End If


Set oStep = Nothing
Set oPKG = Nothing

MsgBox sMessage



Douglas J. Steele

Do you get any error messages? If so, what are they?

If you don't get any error messages, what are the symptoms of the problem?


error: -2147467259
source: Microsoft OLE DB Provider for SQL Server
Description: Cannot open database "mydatabase" requested by the login. The
login failed.

Douglas J. Steele

Does the DTS package run correctly when you run it manually through SQL
Server? The message implies that there's something wrong with how the
package is configured, not with how you're running it.


Runs fine from Ent. Manager

Douglas J. Steele said:
Does the DTS package run correctly when you run it manually through SQL
Server? The message implies that there's something wrong with how the
package is configured, not with how you're running it.

Douglas J. Steele

Sorry, it's been too long since I tried running DTS jobs programmatically.

It's possible someone in microsoft.public.sqlserver.dts might be able to
help you.




Actually, I decided to go another route. I went with using DTSRUN utility
from a sproc and call it from access. I really think either office 2003
service packs or windows security packs caused my previous code to fail.

Thanks for you input anyway.

CODE: (SQL Sproc) *****************

Runs DTS job
@error bit OUTPUT

DECLARE @shell varchar(255)
SET @shell = 'dtsrun /S MYSERVER /N "update_myDB" /U "sa" /P "password"'
exec @error = master..xp_cmdshell @shell
return @error

CODE: (Access) *****************

Function RunDTS() As Boolean

On Error GoTo error_

Dim conn As ADODB.Connection, cmd As ADODB.Command
Dim sMsg As String, sTitle As String, iStyle As Integer

Set conn = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")

conn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security
Info=True;User ID=sa;Password=password;Initial Catalog=myDatabase;Data
conn.CursorLocation = adUseClient

With cmd
.CommandType = adCmdStoredProc
.CommandText = "mySproc"
.ActiveConnection = conn
.Parameters.Append .CreateParameter("@Error", adBoolean,
adParamOutput, 1, False)

If .Parameters("@ERROR") = True Then 'Error in DTS...
Err.Raise "9967", , "Failed to run DTS package!" & vbCrLf
'MsgBox "Data transfer Successful!"
'MsgBox "Data transfer to", vbCritical + vbOKOnly, "Data
sMsg = "Data transfer to Office" & vbCrLf & _
"SQL Server was Successful!"
iStyle = vbInformation + vbOKOnly

sTitle = "Data Transfer"
MsgBox sMsg, iStyle, sTitle
End If
End With

Set cmd = Nothing
Set conn = Nothing
RunDTS = True


Exit Function

Select Case Err.Number
Case Else

MsgBox Err.Number & " " & Err.Description

RunDTS = False
Resume exit_
End Select

End Function

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question