MS VBA | Запустить DTS-пакет (обращение к MS SQL Server)

Чтобы пользователь имел возможность запускать DTS-пакеты со своей машины, обращаясь к удаленному серверу MS SQL, нужно настроить его машину и раздать права.

Итак, пример:

Есть DTS-пакет, разработанный на базе MS SQL Server.

Хотим, чтобы пользователь имел возможность запускать этот пакет, например, нажимая кнопку в приложении MS Excel или MS Access.

➢Объявляем переменные:

Public Const ServerName = "ХХХ" 'IP-адрес машины, на которой стоит MS SQL 2000

Public Const PackageName = "MyPackage" 'Имя DTS-пакета

➢Применяем следующий VBA-код*:

'Убедитесь также, что у пользователя активирована библиотека 'Microsoft DTSPackage Object Library'

Public Sub ExecutePackage(PackageName As String)

On Error GoTo Err

    Dim oPKG As New DTS.Package

    oPKG.LoadFromSQLServer ServerName, , , _

        DTSSQLStgFlag_UseTrustedConnection, , , , PackageName

    oPKG.Execute

    oPKG.UnInitialize

    Set oPKG = Nothing

Exit Sub

Err:

     Err.Raise Err.Number, Err.Description

     Exit Sub

End Sub

➢Чтобы проверить качество запуска пакета, можно воспользоваться вот этим готовым куском:

Function getErrors(oPackage As DTS.Package) As String

    Dim result As String

    result = ""

     Dim lpErrorCode As Integer

     lpErrorCode = -1

     Dim ErrSource As String

     Dim ErrDescription As String

     For i = 1 To oPackage.Steps.Count

         If oPackage.Steps(i).ExecutionResult = DTSStepExecResult_Failure Then

             With oPackage.Steps(i)

               .GetExecutionErrorInfo lpErrorCode, ErrSource, ErrDescription

               Debug.Print lpErrorCode

               Debug.Print ErrSource

               Debug.Print ErrDescription

             End With

             result = result + oPackage.Steps(i).Name + " failed " + ErrSource + ", " + ErrDescription + " (" + lpErrorCode + "); "

         End If

     Next i

End Function