Dim strIn
Dim strOut
Dim NumRow
Dim NumCol
Dim i
Dim j
Dim MyArrays()
Dim objExcel

Sub doWork(Data,Index)
 Select Case Index
  Case "doOpen"
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open (Data)
     For i=1 To objWorkbook.Sheets.Count                  'Листы начинаются не с "0", а с "1"
      sys.onRead objWorkbook.Sheets(i).Name               'Выводим имя наружу 
     Next
    sys.onRead 0  
    sys.onOpen 1
  Case "doRead"                               'На вход подаётся строка, содержащая (разделитель -- точка с запятой): НомерСтроки;НомерКолонки;
    strIn = CStr(Data)
    i = InStr(1,strIn,";",0)
    NumRow = CLng(Mid(strIn, 1, i-1))
    NumCol = CLng(Mid(strIn,i+1))
    strOut = objExcel.ActiveSheet.Cells(NumRow, NumCol).Value
    sys.onCells strOut  
  'Считывание таблицы с xls
  Case "doReads"
    strOut = ""
    NumRow = 1
    NumCol = 5
    
    Do While Not IsEmpty(objExcel.ActiveSheet.Cells(NumRow, 1).Value)
       Do While Not IsEmpty(objExcel.ActiveSheet.Cells(NumRow, NumCol).Value)
          strOut = strOut & objExcel.ActiveSheet.Cells(NumRow, NumCol).Value & ";"
          NumCol = NumCol + 1
       Loop
       strOut = strOut & vbCrLf
       NumCol = 5
       NumRow = NumRow + 1
    Loop
                   
    sys.onReads strOut 
    'конец Считывание таблицы xls
        
  Case "doWrite"                              'На вход подаётся строка, содержащая (разделитель -- точка с запятой): НомерСтроки;НомерКолонки;ЗаписываемоеЗначение
    strIn = CStr(Data)
    i = InStr(1,strIn,";",0)
    NumRow = CLng(Mid(strIn, 1, i-1))
    j = InStr(i+1,strIn,";",0)
    NumCol = CLng(Mid(strIn, i+1, j-i-1))
    strIn =  Mid(strIn, j+1)
    objExcel.ActiveSheet.Cells(NumRow, NumCol).Value=strIn
    sys.onRead strIn
   Case "doSheet"                              'На вход подаётся строка, содержащая имя Листа
    objExcel.Sheets(Data).Select
    objExcel.ActiveSheet.Cells(1, 1).Select 
   Case "doArray"
     REDIM MyArrays(10)
     MyArrays = Sys.MyArray
     'MyArrays.Add(666)
     'MyArrays.Set(0, 123)
     'sys.onArray(MyArrays.Count)
     'sys.onArray(MyArrays.Get(0))
     'DIM IPArray()
     'REDIM IPArray(ip1.Count)
     'For I = 0 To (ip1.Count - 1)
     'IPArray(I) = ip1.Get(I)
     'Next I 
   Case "doGetColorIndex"
    strIn = CStr(Data)
    i = InStr(1,strIn,";",0)
    NumRow = CLng(Mid(strIn, 1, i-1))
    NumCol = CLng(Mid(strIn,i+1))
    strOut = CStr(objExcel.ActiveSheet.Cells(NumRow, NumCol).Font.ColorIndex)+";"_
           + CStr(objExcel.ActiveSheet.Cells(NumRow, NumCol).Interior.ColorIndex)
    sys.onGetColorIndex strOut   
   Case "doClose"
    objExcel.Quit
    Set objExcel = Nothing
    sys.onOpen 0    
 End Select

End Sub

Dim objExcel


Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Input Files|*.PlayReport|All Files|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = ""
intResult = objDialog.ShowOpen

    If intResult = 0 Then
        WScript.Quit
    Else
        InputFile = objDialog.Filename
    End If


arr = Split(""" date=""|"" time=""|"" duration=""|"" fadeIn=""|"" file=""|"" fadeOut=""|"" realDuration=""|"" error=""", "|")

Set ts = CreateObject("Scripting.FileSystemObject").OpenTextFile(InputFile, 1)
s = ts.ReadAll
ts.Close

For Each el In arr
    s = Replace(s, el, "|||")
Next

arrstr = Split(s, vbCrLf)    'массив строк текста целиком

ReDim out(UBound(arrstr), 3)

out(ii, 0) = "Имя файла"
out(ii, 1) = "Время выхода"
out(ii, 2) = "Продолжительность"
out(ii, 3) = "Ошибка"

For i = 0 To UBound(arrstr)
    If Left(arrstr(i), 17) = "<item type=""Movie" Then
        arrstrstr = Split(arrstr(i), "|||")
        ii = ii + 1
      a = split(arrstrstr(5),"\")
        out(ii, 0) = split(a(ubound(a)),".")(0)
        out(ii, 1) = arrstrstr(2)
        out(ii, 2) = arrstrstr(3)
        If Left(arrstrstr(8), 1) = "1" Then out(ii, 3) = arrstrstr(7)
    End If
Next

ActivateExcel

objExcel.Workbooks.Add    '# открываем новую книгу Excel

objExcel.Cells(2, 2).Resize(ii, 3).NumberFormat = "h:mm:ss"

With objExcel.Cells(1, 1).Resize(ii + 1, 4)
    .Value = out
    .EntireColumn.AutoFit()
End With

Private Function ActivateExcel()
    On Error Resume Next
    Set objExcel = GetObject(, "Excel.Application")
    If objExcel Is Nothing Then
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Visible = True
    End If
End Function