DTS Package execute from VBA

I have no idea where to post this thread.

Anyway, what my problem is, is I have a VBA application that executes a SQL Server DTS package. When it executes I get the following message box, I've attached in a word doc. Below is my code to execute it in VB:

Public Sub ExecuteDTSPackage()

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 = "myDatabase"
'sUsername = ""
'sPassword = ""
sPackageName = "myPackage"


' Load Package
oPKG.LoadFromSQLServer sServer, , , _
DTSSQLStgFlag_UseTrustedConnection, , , , sPackageName

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

' Execute
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

' Display Results
MsgBox sMessage

End Sub

But if I go to the database and manually run the package it works fine.

Does anyone know how to fix this?

Thanks