使用VBA网页抓取时如何获取HTML的Anchor标签及坐标参数

问题说明 #

需要抓取riggertalk网站钻井平台列表页面，每页约24条条目，每个条目的「Map View」链接href属性中包含目标经纬度坐标。现有VBA代码可获取列表内容，但无法提取该链接的href属性。

目标HTML片段 #

<h3>Drilling Rigs</h3>
<div class="listing">
  <div class="listing_details">
    <div class="listing_name_loc">
      <div class="listing_name">AKITA Drilling Ltd. </div>
    </div>
    <p class="listing_desc_drilling">
      Rig: 25<br>
      Job: 2503232704<br>
      Operator: Cenovus Energy Inc.<br>
      Location: 12-04-071-4W4<br>
      Status: MOVING </p>
  </div>
  <div class="listing_buttons">
    <a href="/drillingrigs/akitadrillingltd.25" class="show-details">Details</a>
    <a href="/drilling_rigs.php?Keywords=&currentLat=55.12101337&currentLng=-110.56680455&currentZoom=13&isSubmitted=keyword&drid=akitadrillingltd.25">Map View</a>
  </div>
</div>

原有VBA代码 #

Sub scrape_rig_list()
    Dim browser As InternetExplorer
    Dim page As HTMLDocument
    Dim listing As Object
    Dim listing_buttons As Object
    Dim href As String
'open up riggertalk
    Set browser = New InternetExplorer
    browser.Visible = True
    browser.navigate ("https://riggertalk.com/drilling_rigs_list.php?tStatus_Drilling=1&tStatus_Moving=1&tStatus_Down=0&tStatus_Available=&tStatus_ActiveSR=&tStatus_AvailableSR=&centerLat=53.304621&centerLng=-109.995117&centerZoom=5&isSubmitted=locate&infoContent=")
    Do While browser.Busy: Loop
'define each listing
    Set page = browser.document
    Set listing = page.getElementsByClassName("listing")
    Set listing_buttons = page.getElementsByClassName("listing_buttons")
'grab all of them listed on the page
    For num = 1 To 25
        Cells(num, 1).Value = listing.Item(num - 1).innerText
    Next num

    
    browser.Quit
End Sub

解决方案 #

修改代码，遍历每个listing条目，定位到其下的listing_buttons中的「Map View」链接，提取href并解析经纬度：

修改后的VBA代码 #

Sub scrape_rig_list_with_coords()
    Dim browser As InternetExplorer
    Dim page As HTMLDocument
    Dim listings As Object
    Dim singleListing As Object
    Dim listingButtons As Object
    Dim linkElements As Object
    Dim mapLink As Object
    Dim hrefStr As String
    Dim lat As String, lng As String
    Dim rowNum As Integer
    
    '初始化浏览器并打开目标页面
    Set browser = New InternetExplorer
    browser.Visible = True
    browser.navigate "https://riggertalk.com/drilling_rigs_list.php?tStatus_Drilling=1&tStatus_Moving=1&tStatus_Down=0&tStatus_Available=&tStatus_ActiveSR=&tStatus_AvailableSR=&centerLat=53.304621&centerLng=-109.995117&centerZoom=5&isSubmitted=locate&infoContent="
    
    '等待页面加载完成（补充readyState判断更可靠）
    Do While browser.Busy Or browser.readyState <> 4
        DoEvents
    Loop
    
    Set page = browser.document
    Set listings = page.getElementsByClassName("listing")
    rowNum = 1
    
    '遍历每个钻井平台条目
    For Each singleListing In listings
        '写入条目基础信息到A列
        Cells(rowNum, 1).Value = singleListing.innerText
        
        '定位当前条目下的按钮容器
        Set listingButtons = singleListing.getElementsByClassName("listing_buttons")(0)
        '获取容器内的所有a标签
        Set linkElements = listingButtons.getElementsByTagName("a")
        
        '找到Map View链接（通过文本判断更稳定）
        For Each mapLink In linkElements
            If mapLink.innerText = "Map View" Then
                hrefStr = mapLink.href
                '从href中解析经纬度参数
                lat = GetParameterFromURL(hrefStr, "currentLat")
                lng = GetParameterFromURL(hrefStr, "currentLng")
                
                '写入经纬度到B、C列
                Cells(rowNum, 2).Value = lat
                Cells(rowNum, 3).Value = lng
                Exit For
            End If
        Next mapLink
        
        rowNum = rowNum + 1
    Next singleListing
    
    browser.Quit
End Sub

'辅助函数：从URL中提取指定参数的值
Function GetParameterFromURL(url As String, paramName As String) As String
    Dim paramStart As Integer
    Dim paramEnd As Integer
    Dim paramValue As String
    
    paramStart = InStr(url, paramName & "=") + Len(paramName & "=")
    If paramStart = Len(paramName & "=") Then
        GetParameterFromURL = ""
        Exit Function
    End If
    
    paramEnd = InStr(paramStart, url, "&")
    If paramEnd = 0 Then paramEnd = Len(url) + 1
    
    paramValue = Mid(url, paramStart, paramEnd - paramStart)
    GetParameterFromURL = paramValue
End Function

关键修改说明 #

1. 条目内部分层定位：从单个listing内部获取对应的listing_buttons，避免条目顺序错位问题。
2. 正确获取链接标签：使用getElementsByTagName("a")获取链接（原代码错误使用getElementsByClassName("a")，a是标签名而非类名）。
3. 精准筛选目标链接：通过链接文本"Map View"定位目标链接，比依赖位置（第二个a标签）更稳定。
4. 解析经纬度参数：新增辅助函数从href字符串中提取currentLat和currentLng的值，直接得到可用坐标。
5. 完善加载判断：补充readyState <> 4的判断，确保页面完全加载后再执行后续操作。

内容的提问来源于stack exchange，提问作者Rourke