两天找不到原因,谢谢帮忙解决!Option Explicit
Dim WithEvents pkg As DTS.PackagePrivate Sub Command1_Click()
    Dim stp As DTS.Step
    Set pkg = New DTS.Package
    pkg.LoadFromSQLServer ServerName:="yourservername", _
        Flags:=DTSSQLStgFlag_UseTrustedConnection, _
        PackageName:="D:\Documents and Settings\xiangxx.COM\My Documents\test.dts"
    For Each stp In pkg.Steps
        stp.ExecuteInMainThread = True
    Next
    pkg.FailOnError = True
    pkg.Execute
    Set pkg = Nothing
End SubPrivate Sub pkg_OnError(ByVal EventSource As String, ByVal ErrorCode As Long, ByVal Source As String, ByVal Description As String, ByVal HelpFile As String, ByVal HelpContext As Long, ByVal IDofInterfaceWithError As String, pbCancel As Boolean)
    Debug.Print "An error occurred." & vbCrLf & _
        "Event source: " & EventSource & vbCrLf & _
        "Error code: " & ErrorCode & vbCrLf & _
        "Source: " & Source & vbCrLf & _
        "Description: " & Description
End SubPrivate Sub pkg_OnFinish(ByVal EventSource As String)
    'stub
End SubPrivate Sub pkg_OnProgress(ByVal EventSource As String, ByVal ProgressDescription As String, ByVal PercentComplete As Long, ByVal ProgressCountLow As Long, ByVal ProgressCountHigh As Long)
    Static cnt As Integer
    Debug.Print "Step " & cnt
    cnt = cnt + 1
End SubPrivate Sub pkg_OnQueryCancel(ByVal EventSource As String, pbCancel As Boolean)
    Static cnt As Integer
    If pbCancel Then
        cnt = cnt + 1
        Debug.Print " Resetting value of pbCancel flag, count = " & cnt
        pbCancel = False
    End If
End SubPrivate Sub pkg_OnStart(ByVal EventSource As String)
    'stub
End Sub