1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
| Sub Test()
GetTableFromWeb "https://tianqi.2345.com/wea_history/71141.htm", ".history-table", Range("A1")
End Sub
Function GetTableFromWeb(url As String, tableSelector As String, target As Range)
Dim sResponse As String, html As HTMLDocument, clipboard As Object
Set html = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.send
sResponse = ByteToText(.responseBody, "utf-8")
End With
html.body.innerHTML = sResponse
With html
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboard.SetText .querySelector(tableSelector).outerHTML
clipboard.PutInClipboard
End With
target.PasteSpecial
End Function
Function ByteToText(body, Cset)
Dim objstream
Set objstream = CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode = 3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
ByteToText = objstream.ReadText
objstream.Close
Set objstream = Nothing
End Function
|