Блог

У меня есть 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" amp; 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" amp; 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
 

Полностью избавьтесь от IE и переключитесь на запросы xmlhttp, которые надежны и менее подвержены ошибкам. Когда вы переходите на xhr, вам нужно отправлять http-запросы post с соответствующими параметрами. Это то, что вы можете сделать, чтобы получить результаты прямо рядом 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$, Iamp;, Ramp;, 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=" amp; 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>" amp; .item(I).ParentNode.outerHTML amp; "</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
 

Ключевым словом для поиска будет то, что вы видите на этом изображении.