数据未从 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