首页 > 解决方案 > 如何在网络输入字段上点火?

问题描述

我正在尝试在网络输入字段上点火,我尝试使用 fireevent。但似乎这个网页没有认识到我的价值,这是我最后一次尝试:

Sub Import()

    Dim IE As InternetExplorer 
    Set IE = New InternetExplorer 
    IE.Visible = True 
    IE.Navigate "http://loterias.caixa.gov.br/wps/portal/loterias/landing/lotofacil"


    Do While IE.Busy = True
       Application.StatusBar = "Acessando Portal ..."
       DoEvents           
   Loop

    Do While IE.Busy = True
        DoEvents
    Loop

    While IE.ReadyState <> READYSTATE_COMPLETE
    Wend

    sng = Timer

    Do While sng + 1 > Timer
    Loop

    IE.Document.getElementById("buscaConcurso").Focus
    IE.Document.all("buscaConcurso").Value = "1692"

    Call TimerMore

    Call IE.Document.parentWindow.execScript("javascript: arregaResultadoForm($event)", "JavaScript")

End Sub

Sub TimerMore()

    newHour = Hour(Now())
    newMinute = Minute(Now())
    newSecond = Second(Now()) + 3
    waitTime = TimeSerial(newHour, newMinute, newSecond)
    Application.Wait waitTime

End Sub

文本框

$scope.carregaResultadoForm = function (keyEvent){
        if(keyEvent.which===13){
            $scope.carregaResultado($scope.concursoSearch);
            startLoader();
        }
    }

标签: angularjsexcelvbaweb-scrapingautomation

解决方案


硒:

可以对此进行改进,但使用selenium basic。安装后添加对 selenium 类型库和 HTML 对象库的引用。

Option Explicit
Public Sub GetInfo()
    Dim d As WebDriver, keys As New Selenium.keys, html As New HTMLDocument
    Set d = New ChromeDriver
    Const Url = "http://loterias.caixa.gov.br/wps/portal/loterias/landing/lotofacil"
    With d
        .AddArgument "--headless"
        .Start "Chrome"
        .get Url
        .FindElementById("buscaConcurso").SendKeys 1692
        .FindElementById("buscaConcurso").SendKeys keys.Enter
        Application.Wait Now + TimeSerial(0, 0, 2)
        html.body.innerHTML = .PageSource
        Application.ScreenUpdating = False
        WriteTable html.querySelector(".simple-table.lotofacil"), 1, ActiveSheet
        Application.ScreenUpdating = True
       .Quit
   End With
End Sub

Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)

    If ws Is Nothing Then Set ws = ActiveSheet

    Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, R As Long, c As Long, tBody As Object
    R = startRow
    With ws
        Dim headers As Object, header As Object, columnCounter As Long
        Set headers = hTable.getElementsByTagName("th")
        For Each header In headers
            columnCounter = columnCounter + 1
            .Cells(startRow, columnCounter) = header.innerText
        Next header
        startRow = startRow + 1
        Set tBody = hTable.getElementsByTagName("tbody")
        For Each tSection In tBody               'HTMLTableSection
            Set tRow = tSection.getElementsByTagName("tr") 'HTMLTableRow
            For Each tr In tRow
                R = R + 1
                Set tCell = tr.getElementsByTagName("td")
                c = 1
                For Each td In tCell             'DispHTMLElementCollection
                    .Cells(R, c).Value = td.innerText 'HTMLTableCell
                    c = c + 1
                Next td
            Next tr
        Next tSection
    End With
End Sub

XHR:

您还可以使用API获取 JSON 响应并解析您想要的信息:

Option Explicit
Public Sub GetInfo()
    Dim strURL As String, strJSON As String, Http As Object, concurso As Long
    concurso = 1692
    strURL = "http://confiraloterias.com.br/api0/json.php?loteria=lotofacil&concurso=" & concurso & "&token=dO7rI7JcyfnSlFn"

    Set Http = CreateObject("MSXML2.XMLHTTP")
    With Http
        .Open "GET", strURL, False
        .send
        strJSON = .responseText
    End With

    Debug.Print Split(Split(strJSON, "[")(1), "]")(0)
End Sub

JSON 响应的示例部分:

回复


推荐阅读