Question

因此，当前，我的代码打开一个网页，然后将我的电子表格中的产品代码输入搜索栏，然后导航到下一页。宏从此处从网页上拍摄一张图片，并将其放在我的电子表格中。

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

我已经尝试过像下面那样运行一个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

Answer 1

产品页面上有一个与产品图片相关联的ID，该ID在搜索页面上不存在。您可以使用定时循环来查找。

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

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 request-这是浏览器的工作。它快得多，并且不需要打开浏览器，也不需要定时循环。

您在查询字符串中传递productId并获得json响应。正确的方法是使用jsonparser处理响应并解析出图像URL。诸如使用split之类的最佳方法较少。

例如带有响应字符串拆分的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脚本运行时的引用。

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>工具>参考）：

Microsoft HTML对象库

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

1 个答案: