'**********************************************************************************
' Процедура: RunDTS
' Создана  : 02.12.2003 15:06 в версии 1.0.0 Автор: AKU
'**********************************************************************************
' Параметры:
'   None
'**********************************************************************************
' Описание : Запускает DTS на сервере
'**********************************************************************************
Public Sub RunDTS()
On Error GoTo err_proc
    Dim dtsPackage As DTS.Package
    Dim strComputers As String
    
    Screen.MousePointer = vbHourglass
    Set dtsPackage = New DTS.Package
    'Создается соединение с DTS пакетом
    dtsPackage.LogFileName = App.Path & "\" & "DTSErrors.Log"
    dtsPackage.LoadFromSQLServer ServerName:=l_Settings.ConsolidServer, _
                                 Flags:=DTSSQLStgFlag_UseTrustedConnection, _
                                 PackageName:="GatherConsolid"
                               
    Dim oSourceDatabase As clsSourceDatabase
    Dim oMessage As clsStatManagerMessage
    Set oMessage = New clsStatManagerMessage
    oMessage.MesssageType = eiInfo
    
    'Цикл - выполнение переноса данных из каждой БД источника
    For Each oSourceDatabase In l_Settings.SourceDatabases
On Error GoTo StaticPlaceFailed
        Set oMessage.SourceDatabase = oSourceDatabase
        oMessage.Message = "Data Transfer started"
        RaiseEvent StatisticsMessage(oMessage)
        Dim oConnection As DTS.Connection
           For Each oConnection In dtsPackage.Connections
            If oConnection.Name = "SourceConnection" Then
                oConnection.DataSource = oSourceDatabase.File
            End If
        Next
        dtsPackage.Execute
        oMessage.Message = "Data Transfer comleted"
        strComputers = strComputers + oSourceDatabase.Place + " "
        RaiseEvent StatisticsMessage(oMessage)
NextSourceDB:
        RaiseEvent SourceDatabaseProceded
On Error GoTo err_proc
    Next
    'Теперь запишем инфо. об успешно сконсолидированных базах в консолид
    WriteSummaryToConsolid strComputers
    '... и сообщим об этом всем
    RaiseEvent AllSourceDatabasesProceded
    Screen.MousePointer = vbArrow

Exit Sub
err_proc:
    l_Error.SaveErrorInStack "clsStatisticsManager.RunDTS"
    Screen.MousePointer = vbArrow
    l_Error.RaiseError "clsStatisticsManager.RunDTS"
    Exit Sub
StaticPlaceFailed:
    oMessage.Tag = Err.Description
    oMessage.MesssageType = eiError
    RaiseEvent StatisticsMessage(oMessage)
    Resume NextSourceDB
End Sub