ブラウザもSeleniumも使わずExcelVBAでスクレイピング

Option Explicit

'HTTP通信用クラス

Private client As Object
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)

'コンストラクタ


Private Sub Class_Initialize()
    Set client = CreateObject("MSXML2.ServerXMLHTTP")
End Sub

'デストラクタ

Private Sub Class_Terminate()
    Set client = Nothing
End Sub

'引数のURLをGETで取得
'
'url:URL文字列
'return:取得したページ
'
Public Function GetPage(url As String) As String

    client.Open "GET", url
    
    Sleep 2000 'スクレイピングのマナー(1000以上を設定のこと)
    client.Send
    
    'readyStateの値が4で読み込みが完了
    Do While client.readyState < 4
        DoEvents
    Loop
    
    
    Dim statusCode As Integer
    statusCode = client.Status
    
    Dim responseText As String
    Dim lNum1 As Long, lNum2 As Long, stMoji As String
    
    'HTTPのステータスコードが200(OK)以外であれば、ステータスコードなどを返す
    If (statusCode = 200) Then
    
        '取得した文字列を変数へ
        responseText = client.responseText
        
        '文字コード把握
        lNum1 = InStr(1, responseText, "charSet")
        lNum2 = InStr(lNum1, responseText, ">")
        stMoji = Mid(responseText, lNum1, lNum2 - lNum1)
        stMoji = Replace(stMoji, "charSet", "")
        stMoji = Replace(stMoji, "=", "")
        stMoji = Replace(stMoji, "/", "")
        stMoji = Replace(stMoji, " ", "")
        stMoji = Replace(stMoji, """", "")
        Select Case LCase(stMoji)
            Case "utf-8"
                GetPage = client.responseText
            Case Else
                GetPage = StrConv(client.responseText, vbUnicode)
        End Select
    Else
        GetPage "HTTP StatusCode:" & statusCode & "," & vbCrLf & "HTTP StatusText:" & client.statusText
    End If
End Function

Sub HTTPリクエスト()

    Dim client As Http 
    Set client = New Http
    
    Dim response As String
    response = client.GetPage("https://www.yahoo.co.jp/")
    
'    Dim localHtml As HTMLDocument    '←これだとコンパイルエラーになる
    Dim localHtml As Object
    Set localHtml = New HTMLDocument 'CreateObject("htmlfile")

    localHtml.write response    'HTTP通信でとってきたテキストデータをlocalHtml変数に書き込む

    Debug.Print localHtml.innerText

    Set localHtml = Nothing
    Set client = Nothing
End Sub

Option Explicit
Sub HTTPリクエスト()

    Dim client As Http
    Set client = New Http
    
    Dim response As String
    response = client.GetPage("https://www.yahoo.co.jp/")
    
'    Dim localHtml As HTMLDocument
    Dim localHtml As Object
    Set localHtml = New HTMLDocument 'CreateObject("htmlfile")
    
    localHtml.write response

    Dim nodes As Object
    Set nodes = localHtml.getElementsByTagName("div")
    
    Dim node As HTMLUListElement
    Const cstClassName As String = "TRuzXRRZHRqbqgLUCCco9"  'tabTopics1の記事一覧のクラス名
    For Each node In nodes
        If node.className = cstClassName Then
            Debug.Print node.innerText
        End If
    Next node
    
    Set nodes = Nothing
    Set localHtml = Nothing
    Set client = Nothing
End Sub