分类导航

程序问答发布时间：2022-06-02 发布网站：大佬教程 code.js-code.com

大佬教程收集整理的这篇文章主要介绍了用于在网站上搜索元素并重复搜索的 VBA 代码，大佬教程大佬觉得挺不错的，现在分享给大家，也给大家做个参考。

如何解决用于在网站上搜索元素并重复搜索的 VBA 代码？

开发过程中遇到用于在网站上搜索元素并重复搜索的 VBA 代码的问题如何解决？下面主要结合日常开发的经验，给出你关于用于在网站上搜索元素并重复搜索的 VBA 代码的解决方法建议，希望对你解决用于在网站上搜索元素并重复搜索的 VBA 代码有所启发或帮助；

我对 VBA 和网页抓取还很陌生，但我已经阅读了很多试图学习的内容。

我在 Excel 文件的 A 列中有很长的地址列表。我想在网站 http://www.parkopedia.com 上搜索这些地址中的每一个。该网站会根据给定的地址查找最近的停车位和费用。

根据结果，我想提取两个 Span 标签的内部文本。这个内部文本表示最近停车的成本和到停车的距离。

    <div class="LOCATIOnListItem__searchDetails">
     <div class="LOCATIOnDetailsSearchDetails">
      <div class="LOCATIOnDetailsSearchDetails__detail">
       <span class="LOCATIOnDetailsSearchDetails__detail__value">Free</span>
       <span class="LOCATIOnDetailsSearchDetails__detail__label">2 hours</span>
      </div>
     <div class="LOCATIOnDetailsSearchDetails__detail">
      <span class="LOCATIOnDetailsSearchDetails__detail__value">20 </span>

在这种情况下，我想将“免费”和“20”拉入电子表格的 B 列和 C 列。但看起来它们都有相同的类名“LOCATIOnDetailsSearchDetails__detail”

我有大约 1500 个结果要搜索，因此如果可能，最好使用 xmlhttp。

我搜索的第一个地址是“10 herRMANn place new york 10710”

以下是我尝试过的代码。现在，我将 URL 直接输入到代码中，而不是从 Excel 文件中提取。一旦我可以从站点获取正确的数据，我将弄清楚如何获取正确的 URL 以进行拉取。 B2 中的数据目前是空白的，因此它只提取基本 URL，最后没有其他内容。

我似乎遇到的问题是找到一种方法使下面的行正常工作。

GetParkingData = HTMl.getFirstSpanWithClass('LOCATIOnDetailsSearchDetails__detail__value').innerText

模块

Option Explicit
Public Sub GeTinfo()
Dim http As clshttp,sResponse As String,lastRow As Long,groupResults(),i As Long,HTML As HTMLdocument
Set HTML = New HTMLdocument
Set http = New clshttp
Const BASE_URL As String = "https://en.parkopedia.com/parking/LOCATIOns/10_herRMANn_place_new_york_10710_united_states_1jegdr72zr6xf2yc83/?arriving=202107131800&leaving=2021071320000"
Application.Screenupdating = false

With ThisWorkbook.Worksheets("Sheet1")
    lastRow = .Cells(.Rows.Count,"B").End(xlUp).Row
    SELEct Case lastRow
    Case 1
        Exit Sub
    Case 2
        ReDim arr(1,1): arr(1,1) = .Range("B2").Value
    Case Else
        arr = .Range("B2:B" & lastRow).Value
    End SELEct

    ReDim groupResults(1 To lastRow - 1)

    With http
        For i = LBound(arr,1) To UBound(arr,1)
            If Len(BASE_URL & arr(i,1)) > Len(BASE_URL) Then
                sResponse = .GetHTML(BASE_URL & arr(i,1))
                HTML.body.INNERHTML = sResponse
                groupResults(i) = .GetParkingData(HTML)
                sResponse = vbNullString: HTML.body.INNERHTML = vbNullString
            End If
        Next
    End With
    For i = LBound(groupResults) To UBound(groupResults)
        .Cells(i + 1,"C") = groupResults(i)
    Next
End With
Application.Screenupdating = True
End Sub

类 Clshttp

Option Explicit
Private http As Object
Private Sub Class_Initialize()
Set http = CreateObject("MSXML2.XMLhttp")
End Sub

Public Function GetHTML(ByVal URL As String) As String
Dim sResponse As String
With http
    .open "GET",URL,false
    .send
    GetHTML = StrConv(.responseBody,vbUnicodE)
End With
End Function

Public Function GetParkingData(ByVal HTML As HTMLdocument) As String
On Error GoTo errhand:
 GetParkingData = HTMl.getFirstSpanWithClass('LOCATIOnDetailsSearchDetails__detail__value').innerText
Exit Function
errhand:
GetParkingData = "Not Found"
End Function