2007年4月27日金曜日

excel からdtsをキックするサンプルコード パラメータ、エラー処理付

Public Sub tracePackageError(oPackage As DTS.Package)
Dim ErrorCode As Long
Dim ErrorSource As String
Dim ErrorDescription As String
Dim ErrorHelpFile As String
Dim ErrorHelpContext As Long
Dim ErrorIDofInterfaceWithError As String
Dim I As Integer

For I = 1 To oPackage.Steps.Count
If oPackage.Steps(I).ExecutionResult = DTSStepExecResult_Failure Then
oPackage.Steps(I).GetExecutionErrorInfo ErrorCode, ErrorSource, ErrorDescription, _
ErrorHelpFile, ErrorHelpContext, ErrorIDofInterfaceWithError
MsgBox oPackage.Steps(I).Name & " failed" & vbCrLf & ErrorSource & vbCrLf & ErrorDescription
End If
Next I

End Sub
'エラー処理用
Public Function sAccumStepErrors( _
ByVal objPackage As DTS.Package) As String
'Accumulate the step error info into the error message.
Dim oStep As DTS.Step
Dim sMessage As String
Dim lErrNum As Long
Dim sDescr As String
Dim sSource As String

'Look for steps that completed and failed.
For Each oStep In objPackage.Steps
If oStep.ExecutionStatus = DTSStepExecStat_Completed Then
If oStep.ExecutionResult = DTSStepExecResult_Failure Then

'Get the step error information and append it to the message.
oStep.GetExecutionErrorInfo lErrNum, sSource, sDescr
sMessage = sMessage & vbCrLf & _
"Step " & oStep.Name & " failed, error: " & _
sErrorNumConv(lErrNum) & vbCrLf & sDescr & vbCrLf
End If
End If
Next
sAccumStepErrors = sMessage
End Function

Public Function sErrorNumConv(ByVal lErrNum As Long) As String
'Convert the error number into readable forms, both hexadecimal and decimal for the low-order word.

If lErrNum <> -65536 Then
sErrorNumConv = "x" &amp;amp;amp;amp; Hex(lErrNum) & ", " & CStr(lErrNum)
Else
sErrorNumConv = "x" & Hex(lErrNum) &amp;amp;amp;amp;amp; ", x" & _
Hex(lErrNum And -65536) & " + " & CStr(lErrNum And 65535)
End If
End Function
---------------------------------------------------
'本体
Sub dtsrun伝票()
Dim dtsp As New DTS.Package

Set dtsp = New DTS.Package
dtsp.LoadFromSQLServer ServerName:="xxxxxx", _
ServerUserName:="xxxxx", _
ServerPassword:="xxxxx", _
PackageName:="dts名"
dtsp.GlobalVariables("年月").Value = Worksheets("menu").Cells(3, 2).Value
dtsp.Execute

tracePackageError dtsp

Set dtsp = Nothing
End Sub


sqlserve enterprise managerのデータ変換サービス、dtsのデザイナで
パッケージのプロパティ グローバル変数で変数名を設定
vbaのグローバル変数と dtsデザイナのパラメータが等しくありませんが サンプルで別のdtsの
パラメータを貼り付けたので本来は一致するはずのものです

0 件のコメント:

コメントを投稿