Извлеките информацию из Avaya CMS и вставьте непосредственно в рабочий лист

#excel #vba #runtime-error #avaya

#excel #vba #ошибка во время выполнения #excel-2016 #avaya

Вопрос:

У меня есть приведенный ниже код для извлечения информации из Avaya CMS и вставки ее непосредственно в рабочий лист.

Это работало, пока мы не переключились с Excel 2010 на Excel 2016.

Теперь это выдает мне эту ошибку:

«ошибка времени выполнения ‘-2147319783 (80028019)’:
ошибка автоматизации
, старый формат или недопустимая библиотека типов»

На Set cvsSrv = cvsApp.Servers(1)

 Dim cvsApp As New ACSUP.cvsApplication
Dim cvsSrv As New ACSUPSRV.cvsServer
Dim Rep As New ACSREP.cvsReport
Dim Info As Object, Log As Object, b As Object
Dim logged As Boolean
Dim timevar As String

Public Sub CMS_REL()
Application.ScreenUpdating = 0
sk = "66"

Sheets("Per Teams").Activate
timevar = Range("F20")

Set cvsSrv = cvsApp.Servers(1)
Call doRep("HistoricalDesignerAgent ACD Release (MultiSkill)", sk)

Sheets("Released").Select
Range("A:H").Select
Selection.ClearContents
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Per Teams").Select

logout
Application.ScreenUpdating = 1

End Sub


Sub doRep(sReportName As String, ByVal sk As Integer)

On Error Resume Next
cvsSrv.Reports.ACD = 1
Set Info = cvsSrv.Reports.Reports(sReportName)
If Info Is Nothing Then
    If cvsSrv.Interactive Then
        MsgBox "The Report " amp; sReportName amp; " was not found on ACD 1", vbCritical Or vbOKOnly, "CentreVu Supervisor"
    Else
        Set Log = CreateObject("ACSERR.cvslog")
        Log.AutoLogWrite "The Report " amp; sReportName amp; " was not found on ACD 1"
        Set Log = Nothing
    End If
Else
    b = cvsSrv.Reports.CreateReport(Info, Rep)
    If b Then
        Debug.Print Rep.SetProperty("Splits/Skills", "64-72")
        Debug.Print Rep.SetProperty("Dates", 0)
        Debug.Print Rep.SetProperty("Times", "00:00-" amp; timevar)
        b = Rep.ExportData("", 9, 0, True, True, True)
        Rep.Quit
        If Not cvsSrv.Interactive Then cvsSrv.ActiveTasks.Remove Rep.TaskID
        Set Rep = Nothing
    End If
End If

Set Info = Nothing

End Sub

Sub logout()
Set Log = Nothing
Set Rep = Nothing
Set cvsSrv = Nothing
Set cvsApp = Nothing

End Sub
  

Комментарии:

1. Вам не нужно .Select ничего. Ошибка, при которой

2. в этой строке появляется ошибка «Set cvsSrv = cvsApp.Servers(1)».

Ответ №1:

Измените эту строку

Dim cvsApp As New ACSUP.cvsApplication

к этому

   Dim cvsApp As Object
  Set cvsApp = CreateObject("ACSUP.cvsApplication")