VBA web Scraping - 将 HTMLdoc 转换为 XML，但在单击按钮时遇到错误

Question

我有一个MSHTML.HTMLDocument 代码：

1. 打开页面"https://www.ksestocks.com/HistoryHighLow"

2. 填充输入，即786

3. 然后点击按钮获取表格

4. 我使用以下代码捕获了一行及其 4 个孩子

   Sub KSE_GetHTMLDocument()
   
    Dim IE As New SHDocVw.InternetExplorer
    Dim HTMLDOC As MSHTML.HTMLDocument
    Dim HTMLInput As MSHTML.IHTMLElement
    Dim HTMLClasses As MSHTML.IHTMLElementCollection
    Dim HTMLClass As MSHTML.IHTMLElement
    Dim HTMLCel As MSHTML.IHTMLElement
    Dim colNum, rowNum, RowN, C As Integer
   
    Dim Cel As Range
   
    IE.Visible = False
    IE.Navigate "https://www.ksestocks.com/HistoryHighLow"
   
    Do While IE.ReadyState <> READYSTATE_COMPLETE
    Loop
   
    For Each Cel In Sheets("Sheet1").Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If IsEmpty(Cel.Value) = False Then
   
        Set HTMLDOC = IE.Document
        Set HTMLInput = HTMLDOC.getElementById("selscrip")
   
        HTMLInput.Value = Trim(Cel.Value)
        Debug.Print Cel.Value
        HTMLDOC.getElementsByTagName("input")(0).Click
   
        While IE.Busy Or IE.readyState < 4: DoEvents: Wend
   
        C = 0
        For Each HTMLClass In HTMLDOC.getElementsByTagName("tr")
            If InStr(HTMLClass.innerText, "Last 3 years (") > 0 Then
                If Left(HTMLClass.innerText, 14) = "Last 3 years (" Then
                        For Each HTMLCel In HTMLClass.Children
                            Debug.Print HTMLCel.innerText
                            If C = 1 Then
                            Cel.Offset(0, 7).Value = HTMLCel.innerText
                            ElseIf C = 2 Then
                            Cel.Offset(0, 8).Value = HTMLCel.innerText
                            ElseIf C = 3 Then
                            Cel.Offset(0, 9).Value = HTMLCel.innerText
                            ElseIf C = 4 Then
                            Cel.Offset(0, 10).Value = HTMLCel.innerText
                            End If
                            C = C + 1
                        Next
                End If
            End If
        Next
   End If
   Next    
   End Sub
   

上面的代码在从网站获取值时运行良好，但是当我将代码更改为 XML 时，它停止工作，并且 Internet Explorer 每次都弹出一个新窗口，但没有结果。

我哪里做错了？

有没有更健壮的网页抓取方式？

运行前请检查以下代码

Sub KSE_Get_XML()
    
    Dim XMLp As New MSXML2.XMLHTTP60
    Dim HTMLDOC As New MSHTML.HTMLDocument
    
    Dim HTMLInput As MSHTML.IHTMLElement
    
    Dim HTMLClasses As MSHTML.IHTMLElementCollection
    Dim HTMLClass As MSHTML.IHTMLElement
    
    Dim HTMLCel As MSHTML.IHTMLElement
    
    Dim colNum, rowNum, RowN, C As Integer
    
    XMLp.Open "GET", "https://www.ksestocks.com/HistoryHighLow", False
    XMLp.send
    
    HTMLDOC.body.innerHTML = XMLp.responseText
    
    Dim Cel As Range
    
 '   Do While HTMLDOC.ReadyState <> READYSTATE_COMPLETE
  '  Loop
    
    For Each Cel In Sheets("Sheet1").Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If IsEmpty(Cel.Value) = False Then
        
        HTMLDOC.body.innerHTML = XMLp.responseText
        Set HTMLInput = HTMLDOC.getElementById("selscrip")

        HTMLInput.Value = Trim(Cel.Value)
        Debug.Print Cel.Value
        HTMLDOC.getElementsByTagName("input")(0).Click
        
        'Application.Wait Now + TimeValue("00:00:01")
       '' Do While HTMLDOC.ReadyState <> READYSTATE_COMPLETE
       '     DoEvents
      '  Loop

        C = 0
        For Each HTMLClass In HTMLDOC.getElementsByTagName("tr")
            If InStr(HTMLClass.innerText, "Last 3 years (") > 0 Then
                If Left(HTMLClass.innerText, 14) = "Last 3 years (" Then
                        For Each HTMLCel In HTMLClass.Children
                            Debug.Print HTMLCel.innerText
                            If C = 1 Then
                            Cel.Offset(0, 7).Value = HTMLCel.innerText
                            ElseIf C = 2 Then
                            Cel.Offset(0, 8).Value = HTMLCel.innerText
                            ElseIf C = 3 Then
                            Cel.Offset(0, 9).Value = HTMLCel.innerText
                            ElseIf C = 4 Then
                            Cel.Offset(0, 10).Value = HTMLCel.innerText
                            End If
                            C = C + 1
                        Next
                End If
            End If
            
            
        Next
   End If
   Next

End Sub

Answer 1

完全摆脱 IE 并切换到 xmlhttp 请求，这很健壮且不易出错。当您使用 xhr 时，您需要发出带有适当参数的 post http 请求。您可以执行此操作以从该表中获取位于 Last 3 years (1 Sep 2018 - 1 Sep 2021) 旁边的结果。

Public Sub GetContent()
    Const Url = "https://www.ksestocks.com/HistoryHighLow"
    Dim Http As Object, Html As HTMLDocument, Htmldoc As HTMLDocument
    Dim params$, I&, R&, ws As Worksheet, searchKeyword$
    
    Set Html = New HTMLDocument
    Set Htmldoc = New HTMLDocument
    Set Http = CreateObject("MSXML2.XMLHTTP")
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    R = 2
    
    searchKeyword = "786"   'you can use different search keywords here to get related results
    
    params = "selscrip=" & searchKeyword
    
    With Http
        .Open "POST", Url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.104 Safari/537.36"
        .setRequestHeader "content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send (params)
        Html.body.innerHTML = .responseText
    End With

    With Html.querySelectorAll("td.plain")
        For I = 0 To .Length - 1
            If InStr(.item(I).innerText, "Last 3 years") > 0 Then
                Htmldoc.body.innerHTML = "<table>" & .item(I).ParentNode.outerHTML & "</table>"
                ws.Cells(R, 1) = Htmldoc.querySelectorAll("td.plain")(1).innerText
                ws.Cells(R, 2) = Htmldoc.querySelectorAll("td.plain")(2).innerText
                ws.Cells(R, 3) = Htmldoc.querySelectorAll("td.plain")(3).innerText
                ws.Cells(R, 4) = Htmldoc.querySelectorAll("td.plain")(4).innerText
            End If
        Next I
    End With
End Sub

参考添加：

1. Microsoft XML, v6.0
2. Microsoft HTML Object Library

您的搜索关键字将是您在 this image 中看到的内容。