Dim sh As Worksheet
Dim t!, i%, j%, k%
Dim myXML As Object, myHTML As Object, myTable, URL$
URL = "http://norway.twsthr.info/StockHolders.aspx?stock=1102"
Set sh = Worksheets("Temp")
Set myXML = CreateObject("Microsoft.XMLHTTP")
Set myHTML = CreateObject("HTMLFile")
t = timer
With myXML
.Open "GET", URL, False
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.send
Do While .Status <> 200
DoEvents
If timer - t > 3 Then Exit Do
Loop
If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
myHTML.body.innerHTML = .responsetext
End With
Set myTable = myHTML.getelementsbytagname("TABLE")(10)
With myTable
k = 1
ReDim arDATA(.Rows.Length, .Rows(3).Cells.Length)
For i = 1 To .Rows.Length
On Error Resume Next
For j = 3 To .Rows(3).Cells.Length
arDATA(k, j - 2) = .Rows(i - 1).Cells(j - 1).innertext
Next
If Err.Number = 0 Then k = k + 1
Next
On Error GoTo 0
End With
Set myXML = Nothing
Set myHTML = Nothing
Set myTable = Nothing
End Sub作者: BANK870 時間: 2019-3-3 17:19
謝謝大大請問大大這段語法我有點不懂可以教我嗎?
Do While .Status <> 200
DoEvents
If timer - t > 3 Then Exit Do
Loop
If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
myHTML.body.innerHTML = .responsetext
End With
Set myTable = myHTML.getelementsbytagname("TABLE")(10)
With myTable
k = 1
ReDim arDATA(.Rows.Length, .Rows(3).Cells.Length)
For i = 1 To .Rows.Length
On Error Resume Next
For j = 3 To .Rows(3).Cells.Length
arDATA(k, j - 2) = .Rows(i - 1).Cells(j - 1).innertext
Next
If Err.Number = 0 Then k = k + 1
Next
On Error GoTo 0
End With
1. 回給對方時請按 "回復" 二字,對方才會收到帖子的信息
2. 以下這一段是在等候資料是否已備妥,假如3秒內未備妥就先放棄,
但這只是實驗,網頁方傳遞資料時期是不是給狀態信息這一件事還要學習。
所以以下這一段可以刪除 試試看
Do While .Status <> 200
DoEvents
If timer - t > 3 Then Exit Do
Loop
3. 網頁的這一個表資料列列間有橫隔線造成讀取資料錯誤,所以用 on error resume next 跳過讀取避免錯誤