如何使用 VBA 从网站上抓取位置名称

Question

我正在尝试从汽车租赁网站主页上抓取取货分行的位置。我们的想法是准确查看给定公司的取货分支机构的位置。

我之前已经成功创建过这个，但是这家公司最近修改了他们的网站，现在我的代码不起作用。分支位置似乎隐藏在某种形式中，只有在您单击取货位置空间后，这些位置才会在 html 中可见。

我当前的代码如下所示：

Option Explicit
Private Sub pickuplocations()
    Dim html As Object
    Dim ws As Worksheet
    Dim headers()
    Dim i As Long
    Dim r As Long
    Dim c As Long
    Dim numrows As Long

        Set ws = ThisWorkbook.Worksheets("Europcar Branches(2)")
        Set html = New HTMLDocument

            With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", "https://www.europcar.co.za", False
            .send
            html.body.innerHTML = .responseText   'fetches all html from the website

    Dim pickupbranches As Object
    Dim pickupbranchresults()

        Set pickupbranches = html.getElementById("_location-search-widget_15").getElementsByTagName("span") 
        headers = Array("Pickup Location", "Option value") 'for the ws
        numrows = pickupbranches.Length - 1   'sets the row length

        ReDim pickupbranchresults(1 To numrows, 1 To 2)  'sets array size for the results
            For i = 1 To numrows
                pickupbranchresults(i, 1) = pickupbranches.Item(i).innerText 
                pickupbranchresults(i, 2) = pickupbranches.Item(i).Value    
            Next

        With ws

            .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers 'sets the column headers
            .Cells(2, 1).Resize(UBound(pickupbranchresults, 1), UBound(pickupbranchresults, 2)) = pickupbranchresults 
        End With
            End With
End Sub

Answer 1

您当前的代码请求源 HTML 代码并尝试抓取它。

但是，正如 cmets 中所解释的，位置列表是在您单击搜索栏时动态加载的，它不是页面源 HTML 的一部分。因此，您的代码不会产生任何结果。

抓取专用于位置的页面更有意义：

https://www.europcar.co.za/rental-locations/

现在，如果您导航到该页面并在页面加载时在浏览器的开发人员工具 (F12) 中检查网络流量，您将看到正在发送 XHR 请求。看起来是这样的：

如果您查看请求的标头和参数，您将看到 url、正文和标头的外观。在这种特殊情况下，没有参数，并且标头对于请求的成功不是必不可少的，因此您只需要 url。

响应的负载是 json 格式。您可以使用this 之类的工具检查其结构。下面是它的样子：

基本上，JSON 由不同的国家组成，每个国家由省份组成，每个省份由相应的分支组成。每个分支都包含所有相应的信息。

要解析这样的响应，您需要一个 JSON 解析器（查看本文末尾）。

TL;DR

代码如下所示：

Option Explicit

Sub getLocations()
Dim req As New WinHttpRequest
Dim url As String, results() As String
Dim sht As Worksheet
Dim responseJSON As Object, country As Object, province As Object, branch As Object
Dim i As Long
Dim rng As Range

Set sht = ThisWorkbook.Worksheets("Name of your Worksheet")
url = "https://www.europcar.co.za/api/rentalLocations/impressLocations"

With req
    .Open "GET", url, False
    .send
    Set responseJSON = JsonConverter.ParseJson(.responseText)
End With

For Each country In responseJSON
    For Each province In country("provinces")
        i = 0
        ReDim results(1 To province("branches").Count, 1 To 5)
        For Each branch In province("branches")
            i = i + 1
            results(i, 1) = country("name")
            results(i, 2) = province("name")
            results(i, 3) = branch("name")
            results(i, 4) = branch("emailAddress")
            results(i, 5) = branch("contactNumber")
        Next branch
        With sht
            Set rng = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
        End With
        rng.Resize(UBound(results, 1), UBound(results, 2)) = results
    Next province
Next country

End Sub

出于演示目的，上面的代码以下列方式打印出结果：

记住我提供的 JSON 结构和示例代码，您可以轻松修改它以满足您的需求。

要使代码正常工作，您需要将以下引用添加到您的项目中（VBE>Tools>References）：

 1. Microsoft WinHTTP Services version 5.1
 2. Microsoft Scripting Runtime

您还需要将this JSON parser 添加到您的项目中。按照链接中的安装说明进行操作，您应该可以开始使用了。