时间戳

首页 > 解决方案 > 打开IE，在网页搜索栏中搜索值，等待下一页加载

excel - 打开IE，在网页搜索栏中搜索值，等待下一页加载

问题描述

所以目前我的代码打开一个网页，然后将我的电子表格中的产品代码输入到搜索栏中并导航到下一页。从这里，宏从网页中拍摄一张照片并将其放在我的电子表格中。

问题是当第二个网页打开太慢时，我从第一个网页获得了一张图片。

我曾尝试运行如下所示的 do while 循环，但它似乎不适用于第二个网页。

我该怎么做才能让宏在抓取图片之前等待第二个网站加载？

With IE
    .Visible = False
    .navigate "https://www.genericwebsitename.com/"
     Do While .Busy Or .readyState <> 4: DoEvents: Loop
     Set Doc = IE.document
     IE.document.getElementsByName("searchterm")(0).Value = 
     Sheets("sheet1").range("c4").Value
     Doc.forms(0).submit
     Do While .Busy Or .readyState <> 4: DoEvents: Loop
End With

标签： excelvba

解决方案

产品页面上有一个 id，与产品图像相关联），该 id 不存在于搜索页面上。您可以使用定时循环来寻找它。

我重新组织了一些代码，主要使用querySelector来应用css 选择器来匹配所需的元素。这将返回单个匹配项，并且比返回整个集合和索引更快、更有效。

Option Explicit

Public Sub GetImageLink()
    Dim ie As Object, imageLink As String, t As Date
    Const MAX_WAIT_SEC As Long = 10

    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = True
        .Navigate2 "https://www.talacooking.com/"

        Do While .Busy Or .readyState <> 4: DoEvents: Loop

        .document.querySelector("[name=searchterm]").Value = "10B10631" 'Sheets("sheet1").Range("c4").Value
        .document.querySelector("form").submit

        Do While .Busy Or .readyState <> 4: DoEvents: Loop

        Dim image As Object
        t = Timer
        Do
            On Error Resume Next
            Set image = .document.querySelector("#product-image img")
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While image Is Nothing

        If Not image Is Nothing Then
            imageLink = image.src
            'download image?
        Else
            imageLink = "Not found"
            'Message to user?
        End If
        .Quit
    End With
End Sub

XHR 对响应字符串进行拆分

您可以绕过问题并执行xhr 请求- 这就是浏览器所做的。它要快得多，并且不需要打开浏览器或需要定时循环。

您在查询字符串中传递 productId 并获得 json 响应。正确的做法是使用 jsonparser 来处理响应并解析出图像 url。还有一些不太理想的方法，例如使用拆分。

例如在响应字符串上拆分的 XHR

Option Explicit

Public Sub test()

    Dim http As Object, productId As String
    Set http = CreateObject("MSXML2.XMLHTTP")
    productId = "10B10631"

    Debug.Print GetImageUrl(http, productId)

End Sub
Public Function GetImageUrl(ByVal http As Object, ByVal productId As String) As String
    Dim s As String
    On Error GoTo errHand:

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.talacooking.com/quicksearch?format=json&searchterm=" & productId, False
        .send
        s = .responseText
        GetImageUrl = Replace$(Split(Split(s, "src=\""")(1), Chr$(34))(0), "\/", "/")
    End With
    Exit Function
errHand:
    GetImageUrl = "Not found"
End Function

带有 json 解析器的 XHR：

重写函数以使用 json 解析器。请注意，感兴趣的 json 中的项目 JsonConverter.ParseJson(.responseText)("results")(1)("html")实际上是 html。该 HTML 必须传递给 HTML 解析器，然后才能提取src.

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

Public Function GetImageUrl(ByVal http As Object, ByVal productId As String) As String
    Dim s As String, json As Object, html As HTMLDocument
    On Error GoTo errHand:
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.talacooking.com/quicksearch?format=json&searchterm=" & productId, False
        .send
        html.body.innerHTML = JsonConverter.ParseJson(.responseText)("results")(1)("html")
        GetImageUrl = html.querySelector(".product-image").src
    End With
    Exit Function
errHand:
    GetImageUrl = "Not found"
End Function

参考资料（VBE > 工具 > 参考资料）：

  1. Microsoft HTML 对象库

推荐阅读