使用 vba 单击搜索按钮时，网页看不到在搜索框中输入的文本

Question

我已经编写了 vba 代码，用于在以下网站的搜索框中输入制造商零件号并单击搜索图标。它可以在搜索框中输入制造商零件号并单击搜索图标，但是当“单击搜索图标时，文本框中输入的文本不会被拾取”。它搜索空数据。

'HTML Part for search icon

<a href="javascript:void(0);" style="float: right; width: 20%; height: 55px; border-top-right-radius: .25rem!important; border-bottom-right-radius: .25rem!important; border: 0; padding: 0!important; background: #dadada; margin: 0!important; display: flex; align-items: center;justify-content: center;text-decoration: none;" ng-click="SearchButtonClick(1)"><em class="fa fa-search" aria-hidden="true" style="color: gray;"></em></a>

差不多一个月了，我尝试了各种不同的方法，也提到了堆栈溢出，比如使用“createEvent(”keyboardevent”)”，但没有任何效果。

' VBA code 
Sub AptivScrapping()

    Dim IE As SHDocVw.InternetExplorer
    Set IE = New InternetExplorer
    IE.Visible = True

    IE.navigate "https://ecat.aptiv.com"

    Do While IE.readyState < READYSTATE_COMPLETE
    Loop

    Dim idoc As MSHTML.HTMLDocument
    Set idoc = IE.document

    idoc.getElementById("searchUserInput").Value = "33188785"

    Dim doc_ele As MSHTML.IHTMLElement
    Dim doc_eles As MSHTML.IHTMLElementCollection

    Set doc_eles = idoc.getElementsByTagName("a")

    For Each doc_ele In doc_eles
        If doc_ele.getAttribute("ng-click") = "SearchButtonClick(1)" Then
            doc_ele.Click
            Exit Sub
        Else
        End If
    Next doc_ele

End Sub

Answer 1

页面执行 xhr 请求以检索搜索结果。单击提交后，您可以在网络选项卡中找到它。这意味着在这种情况下，您可以避免使用浏览器并发出 xhr 请求。响应是 json，所以你需要一个 json 解析器来处理结果。

我会使用jsonconverter.bas 来解析 json。在名为 JsonConverter 的标准模块中安装该链接中的代码后，转到 VBE > 工具 > 参考 > 添加对 Microsoft Scripting Runtime 的引用

我为一个数组设置维度来保存结果。我根据返回的 json 集合中的项目数确定行数，并根据第一个项目字典的大小确定列数。我循环json对象，内部循环集合中每个字典的字典键，并填充数组。我在最后一口气写出数组，这降低了 I/O 成本。

Option Explicit

Public Sub GetInfo()
    Dim json As Object, ws As Worksheet, headers()
    Dim item As Object, key As Variant, results(), r As Long, c As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://ecat.aptiv.com/json/eCatalogSearch/SearchProducts?filter=All&options=&pageSize=10&search=33188785", False
        .send
        Set json = JsonConverter.ParseJson(.responseText)("Products")
    End With
    headers = json.item(1).keys
    ReDim results(1 To json.Count, 1 To UBound(headers) + 1)
    For Each item In json
        r = r + 1: c = 1
        For Each key In item.keys
            results(r, c) = item(key)
            c = c + 1
        Next
    Next
    With ws
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With

Answer 2

您可以这样做：

txt = "33188785"

IE.navigate "https://ecat.aptiv.com/feature?search=" & txt

这将带您直接进入搜索结果。

代码：

Sub AptivScrapping()

    Dim IE As SHDocVw.InternetExplorer
    Dim txt As String

    Set IE = New InternetExplorer

    txt = "33188785"

    IE.Visible = True
    IE.navigate "https://ecat.aptiv.com/feature?search=" & txt

    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop


End Sub

• 这会更快，因为您只需加载一页。

为什么会这样，我不确定，但似乎用于输入文本的 TextBox 在自动添加文本时没有被激活。当我们点击它时，它就会被激活。

Answer 3

我从 Mrxel.com 获得了上述问题的解决方案，下面是该帖子的链接。 https://www.mrexcel.com/forum/excel-questions/1105434-vba-ie-automation-issue-angularjs-input-text-post5317832.html#post5317832

在这种情况下，我需要逐个字符地输入搜索字符串，并在循环内输入 sendKeys 和输入事件。以下是有效的 vba 代码。

    Sub AptivScrapping()

    Dim IE As SHDocVw.InternetExplorer
    Set IE = New InternetExplorer
    IE.Visible = True

    IE.navigate "https://ecat.aptiv.com"

    Do While IE.readyState < READYSTATE_COMPLETE
    Loop

    Dim idoc As MSHTML.HTMLDocument
    Set idoc = IE.document

    IE.document.getElementById("searchUserInput").Focus = True
    IE.document.getElementById("searchUserInput").Select

    sFieldInput = "33188785"
    For s = 1 To Len(sFieldInput)
    Application.SendKeys Mid(sFieldInput, s, 1)
    While IE.readyState < 4 Or IE.Busy
    Application.Wait DateAdd("s", LoopSeconds, Now)
    Wend
    Next s

    IE.document.getElementById("searchUserInput").Focus = False

    Dim doc_ele As MSHTML.IHTMLElement
    Dim doc_eles As MSHTML.IHTMLElementCollection

    Set doc_eles = idoc.getElementsByTagName("a")

    For Each doc_ele In doc_eles
        If doc_ele.getAttribute("ng-click") = "SearchButtonClick(1)" Then
            doc_ele.Click
            Exit Sub
        Else
        End If
    Next doc_ele

End Sub