Executing SQL DTS Package from Access

[scott]

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
Next

oPKG.Execute

' 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
Else
sMessage = sMessage & "Step """ & oStep.name & _
""" Succeeded" & vbCrLf & vbCrLf
End If
Next

oPKG.UnInitialize

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?

 

[scott]

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.

 

[scott]

Runs fine from Ent. Manager

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.

 

[scott]

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) *****************

CREATE PROCEDURE [dbo].[mlc_GRADER_DTS]
/*
Runs DTS job
*/
(
@error bit OUTPUT
)
AS

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
Source=myServer"
conn.CursorLocation = adUseClient
conn.Open

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

If .Parameters("@ERROR") = True Then 'Error in DTS...
Err.Raise "9967", , "Failed to run DTS package!" & vbCrLf
Else
'MsgBox "Data transfer Successful!"
'MsgBox "Data transfer to", vbCritical + vbOKOnly, "Data
Transfer"
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_:

Exit Function
error_:

Select Case Err.Number
Case Else

MsgBox Err.Number & " " & Err.Description

RunDTS = False
Resume exit_
End Select

End Function