2022/04/10

VBA / 使用Excel VBA爬蟲Google搜尋結果 2

補充  VBA / 使用Excel VBA爬蟲Google搜尋結果 除了單純分割字串之外

可以使用 Html Document的方式來解析內容

原理是將XMLHTTP取得的資料，寫入Microsoft XML的Html Document

這樣就可以透過Html Document來處理網頁內容

因為在 Microsoft XML, v6.0 library的版本已經不支援getElementsByClassName()

所以改用 getElementById()

也因此改爬另一個網站來測試

 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
'
'郵遞區號
'使用htmlFile物件
'getElementById
Public Sub xmlHttpGoogle5()
    s = Application.EncodeURL("嘉義市東區宣信街266號")
    
    '使用Microsoft.XMLHTTP物件，傳送網址給對方，然後取回(GET)回傳資料
    Set WinHttpReq = CreateObject("MSXML2.XMLHTTP") '可以不用引用物件
        
    'WinHttpReq.Open "GET", myURL, False, "username", "password"
    WinHttpReq.Open "GET", "http://zip5.5432.tw/zip/" + s, False
    WinHttpReq.send
    
    Set dom = CreateObject("htmlFile")
    '將回傳資料放到dom變數
    dom.body.innerHTML = WinHttpReq.responseText
    
    '確認回傳的狀態是否正常，200代表正常
    If WinHttpReq.Status = 200 Then
'        Debug.Print dom.body.innerHTML
    End If
    Set section = dom.getElementById("new-adrs")
    Debug.Print section.innertext
    Set WinHttpReq = Nothing
    
'   間格時間(單位:秒) 1<= delaysec <= 5
    delaysec = Int((5 - 1 + 1) * Rnd() + 1)
    Debug.Print delaysec
    newHour = Hour(Now())
    newMinute = Minute(Now())
    newSecond = Second(Now()) + delaysec
    waitTime = TimeSerial(newHour, newMinute, newSecond)
    Application.Wait waitTime
End Sub

 

#17

將網站的回傳資料透過body.innerHTML寫入變數dom

#23

透過getElementById()取得目標資料所在的id ：new-adrs

 

參考資料

GetElementsbyClassname: Open IE vs. MSXML2 Methods

【html】在VBA中解析HTML，以從描述列表中提取資訊？

Parse HTML in Excel VBA – Learn by parsing hacker news home page

HtmlDocument Class

VBA / 抓取網路 JSON資料 版本4

繼續補充 VBA處理 Json的方式

VBA / 抓取網路 JSON資料

VBA / 抓取網路 JSON資料 版本2

VBA / 抓取網路 JSON資料 版本3

這個方式是參考〈Excel VBA 經典程式碼─一行抵萬行「偷懶程式碼」應用大全〉的範例

利用VBA引用物件htmlfile (HTML Document)

再透過parentWindow 建立window物件

之後利用execScript將Javascript程式碼寫入window物件並執行

可以透過eval函數來輸入要執行Javascript代碼字串，在windows物件內利用Javascript操作物件

使用eval函數可以避免VBA自動將屬性名稱的第一個字母改成大寫，因為在Javascript大小寫有差異

接下來改寫前一篇的程式碼

Const URl2 As String = "https://script.google.com/macros/s/AKfycbwxkgntkYF25Kk2Khdgn0bSLqxhHvDTRiRTfwJTfTuX4BQzOrpOImxccrRuTWvBZhMXHw/exec?mailID=trico109748007@gmail.com.tw"

 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
38
39
40
41
42
43
44
45
46
47
48
49
50
'
'htmlfile.parentWindow
'Json資料是陣列格式
'
Public Sub test22()

    '刪除舊資料
    Sheets(2).Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    
    '設定 XMLHTTP 物件
    Dim xmlHttp As Object
    Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    xmlHttp.Open "GET", URl2, False
    xmlHttp.send
    
    strJson = xmlHttp.responseText                         '回傳資料內容
'    strJson = "{" & """" & "data" & """" & ":" & strJson & "}"
'
''    Debug.Print strJson
'    Dim html, window
'    Set html = CreateObject("htmlfile")
'    Set window = html.parentWindow
'    window.execScript "var json = " & strJson , "Javascript"
'
'    Debug.Print window.eval("json.data[1].dataload[1]")

    Dim html, window
    Set html = CreateObject("htmlfile")
    Set window = html.parentWindow                            '建立 htmlfile物件 跟 window物件 執行 Javascript
    window.execScript "var json = " & strJson, "Javascript"   '執行 Javascript代碼字串   var json -> window.json
     
'    Debug.Print window.eval("json[1].dataload")             '在windows內Javascript取物件屬性的方式  eval函數可以執行Javascript代碼字串 使用eval 可以避免VBA自動將屬性名稱的第一個字母改成大寫  因為在Javascript大小寫有差異
'    Debug.Print window.eval("json.length")
'    Debug.Print window.eval("json[0].dataload.length")
'    Debug.Print window.eval("json[0].dataload[1]")
'    Debug.Print window.eval("json[1].dataload[1]")
'    Debug.Print window.eval("typeof(json)")
    
    For i = 0 To window.eval("json.length") - 1
        For j = 0 To window.eval("json[0].dataload.length") - 1
            Cells(i + 1, j + 1) = window.eval("json[" & i & "].dataload[" & j & "]")
            
        Next
    Next
    
    Set xmlHttp = Nothing
End Sub

 

#31

用Late binding的方式建立HTML Object 

如果要改用 Early binding，就要引用 Microsoft HTML Object Library

#33

將收到的Json格式資料，透過execScript連同變數宣告語句一起傳入window之中

#42-#47

這邊的迴圈是利用eval函數將要執行的Javascript程式碼傳入到window之中

然後將回傳值寫入儲存格中

 

參考資料

〈Excel VBA 經典程式碼─一行抵萬行「偷懶程式碼」應用大全〉，P17-60

how turn on the Microsoft HTML Object Library reference when using option explicit (excel-vba)?