【エクセル VBA】WinHTTP・XMLHTTP60を使ったスクレイピング　～SeleniumBasic・IEとの速度比較～

Sub WinHTTP_Sample()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.ActiveSheet
    Dim begTime As Variant: begTime = Now()
    ws.Cells(1, 2) = Format(begTime, "yyyy/mm/dd hh:mm:ss")
    Dim req As WinHttp.WinHttpRequest: Set req = New WinHttp.WinHttpRequest
    Dim url As String: url = "https://zeroterasu.com/blog/"
    req.Open "GET", url
    req.Send
    
    Dim html As IHTMLDocument: Set html = New HTMLDocument
    html.write req.ResponseText

    Application.Wait(Now() + TimeValue("00:00:01"))
    Dim inputRow As Long: inputRow = 2
    Dim a As HTMLAnchorElement
    For Each a In html.getElementsByTagName("a")
        If IsNull(a.innerText) Then
            Debug.Print inputRow - 1 & " 番目の<a>タグのテキストが見つかりませんでした。"
            GoTo continue
        End If
        ws.Cells(inputRow, 1).Value = a.innerText
continue:
        If IsNull(a.href) Then
            Debug.Print inputRow - 1 & " 番目の<a>リンク先が見つかりませんでした。"
            GoTo continue2
        End If
        ws.Cells(inputRow, 2).Value = a.href
continue2:
        inputRow = inputRow + 1
        Debug.Print inputRow
    Next a
    ws.Cells(1, 4) = Format(Now(), "yyyy/mm/dd hh:mm:ss")
End Sub

Sub XML_Sample()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.ActiveSheet
    Dim begTime As Variant: begTime = Now()
    ws.Cells(1, 2) = Format(begTime, "yyyy/mm/dd hh:mm:ss")
    Dim req As XMLHTTP60: Set req = New XMLHTTP60
    Dim url As String: url = "https://zeroterasu.com/blog/"
    req.Open "GET", url
    req.Send
    
    Dim html As IHTMLDocument: Set html = New HTMLDocument
    html.write req.ResponseText
    
    Application.Wait(Now() + TimeValue("00:00:01"))
    Dim inputRow As Long: inputRow = 2
    Dim a As HTMLAnchorElement
    For Each a In html.getElementsByTagName("a")
        If IsNull(a.innerText) Then
            Debug.Print inputRow - 1 & " 番目の<a>タグのテキストが見つかりませんでした。"
            GoTo continue
        End If
        ws.Cells(inputRow, 1).Value = a.innerText
continue:
        If IsNull(a.href) Then
            Debug.Print inputRow - 1 & " 番目の<a>リンク先が見つかりませんでした。"
            GoTo continue2
        End If
        ws.Cells(inputRow, 2).Value = a.href
continue2:
        inputRow = inputRow + 1
        Debug.Print inputRow
    Next a
    ws.Cells(1, 4) = Format(Now(), "yyyy/mm/dd hh:mm:ss")
End Sub

Sub SeleniumBasic_Sample()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.ActiveSheet
    Dim begTime As Variant: begTime = Now()
    ws.Cells(1, 2) = Format(begTime, "yyyy/mm/dd hh:mm:ss")
    Dim dr As WebDriver: Set dr = New WebDriver
    dr.AddArgument "--headless"
    dr.Start "Chrome"
    Dim url As String: url = "https://zeroterasu.com/blog/"
    dr.Get url
    
    Application.Wait Now() + TimeValue("00:00:01")
    Dim inputRow As Long: inputRow = 2
    For Each a In dr.FindElementsByTag("a")
        ws.Cells(inputRow, 1).Value = a.Text
        ws.Cells(inputRow, 2).Value = a.Attribute("href")
        inputRow = inputRow + 1
        Debug.Print inputRow
    Next a
    ws.Cells(1, 4) = Format(Now(), "yyyy/mm/dd hh:mm:ss")
End Sub

Sub IE_Sample()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.ActiveSheet
    Dim begTime As Variant: begTime = Now()
    ws.Cells(1, 2) = Format(begTime, "yyyy/mm/dd hh:mm:ss")
    Dim ie As InternetExplorer: Set ie = New InternetExplorer
    Dim url As String: url = "https://zeroterasu.com/blog/"
    ie.navigate url
    
    Do While ie.Busy = True Or ie.readyState < 4
        DoEvents
    Loop
    Dim htmlDoc As HTMLDocument
    Set htmlDoc = ie.document
    Dim inputRow As Long: inputRow = 2
    For Each a In htmlDoc.getElementsByTagName("a")
        ws.Cells(inputRow, 1).Value = a.Text
        ws.Cells(inputRow, 2).Value = a.getAttribute("href")
        inputRow = inputRow + 1
        Debug.Print inputRow
    Next a
    ws.Cells(1, 4) = Format(Now(), "yyyy/mm/dd hh:mm:ss")
End Sub