- 帖子
- 519
- 主題
- 54
- 精華
- 0
- 積分
- 595
- 點名
- 259
- 作業系統
- win 10
- 軟體版本
- []
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-3-19
- 最後登錄
- 2024-11-27
          
|
2#
發表於 2019-3-3 11:40
| 只看該作者
回復 1# BANK870
是這樣嗎?
Sub byXMLhttp_Test()
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
sh.Cells.Clear
sh.[A1].Resize(UBound(arDATA), UBound(arDATA, 2)) = arDATA
Set myXML = Nothing
Set myHTML = Nothing
Set myTable = Nothing
End Sub |
|
