问题描述
我对 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
非常感谢大家!请原谅任何看起来很新手的东西,我正在尝试自学 VBA 和网页抓取。
解决方法
暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!
如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。
小编邮箱:dio#foxmail.com (将#修改为@)