Данные не обновляются из таблицы HTML в Excel

Question

У меня следующая ошибка, данные обновляются на веб-странице, но не в Excel. Я использую Application.OnTime для обновления веб-страницы.

Ниже приведен код

Sub RefreshAction()
Dim htm As Object
Dim Tr As Object
Dim Td As Object
Dim Tab1 As Object
Dim URL As String
Dim Colstart As Long
Dim HTML As Variant
Dim i As Long
Dim j As Long
Dim n As Long
Dim ss As Long


Application.ScreenUpdating = False
URL = "http://register.um.edu.my/kok_kosong_bi.asp"
Set HTML = CreateObject("htmlfile") 'Create HTMLFile Object
With CreateObject("msxml2.xmlhttp") 'Get the WebPage Content
    .Open "GET", URL, False
    .send
    HTML.Body.Innerhtml = .responseText
End With

Colstart = 1
j = 1
i = Colstart
n = 0

'Loop Through website tables
For Each Tab1 In HTML.getElementsByTagName("table")
    With HTML.getElementsByTagName("table")(n)
        For Each Tr In .Rows
            For Each Td In Tr.Cells
                Sheet1.Cells(j, i) = Td.innerText
                i = i + 1
            Next Td
            i = Colstart
            j = j + 1
        Next Tr
    End With
    n = n + 1
    i = Colstart
    j = j + 1
Next Tab1
Application.ScreenUpdating = True
Application.EnableEvents = True
Debug.Print Now() + TimeValue("00:00:05")
Application.OnTime Now() + TimeValue("00:00:05"), "RefreshAction", Schedule = True
End Sub

Снимок

Согласно снимку, веб-сайт имеет 7 строк, но в Excel только 5 строк. Я перепробовал все возможные способы, до сих пор не могу найти причину. Я ожидаю очистки веб-кэша, но не могу найти ссылку для этого.

Answer 1

Номера меняются на сайте. Когда я сначала посмотрел, было 6 рядов, затем 5, а потом снова 6.

Ваш код в порядке, но вам нужно Schedule:=True вместо Schedule = True (опечатка?), И вам действительно нужно зациклить все таблицы? Вы также можете Dim HTML As Object.

Я думаю, что сайт довольно поверхностный, если честно, если он демонстрирует этот тип несоответствия в результатах.

Простой способ получить все строки в любой момент времени - просто скопировать и вставить всю таблицу, как показано ниже. Вы можете связать это с вашим кодом обновления.

Option Explicit
Public Sub GetTable()
    Dim sResponse As String, html As New HTMLDocument, clipboard As Object

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://register.um.edu.my/kok_kosong_bi.asp", False
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With

    html.body.innerHTML = sResponse
    With ThisWorkbook.Worksheets("Sheet1")
        .Cells.ClearContents
        .Cells.ClearFormats
        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        clipboard.SetText html.getElementsByTagName("table")(3).outerHTML
        clipboard.PutInClipboard
        .Cells(1, 1).PasteSpecial
    End With 
End Sub