Excel 使用getElementsByTagName()进行Web抓取
我想将餐厅名称、电话号码、网站和地址等餐厅数据导入excel,但不幸的是,我收到了广告和垃圾数据。我已经创建了一个代码使用的网站,但它不是帮助。请更正我代码中的问题。 网站:Excel 使用getElementsByTagName()进行Web抓取,excel,vba,web-scraping,getelementsbyclassname,Excel,Vba,Web Scraping,Getelementsbyclassname,我想将餐厅名称、电话号码、网站和地址等餐厅数据导入excel,但不幸的是,我收到了广告和垃圾数据。我已经创建了一个代码使用的网站,但它不是帮助。请更正我代码中的问题。 网站: 请不要引用json,因为它不适用于其他网站 Sub Yellowcom() 'Dim ieObj As InternetExplorer Dim htmlELe As IHTMLElement Dim HTML As HTMLDocument Dim i As Integer Di
请不要引用json,因为它不适用于其他网站
Sub Yellowcom()
'Dim ieObj As InternetExplorer
Dim htmlELe As IHTMLElement
Dim HTML As HTMLDocument
Dim i As Integer
Dim URL As String
Dim URLParameter As String
Dim page As Long
Dim links As Object
Dim IE As Object
i = 1
Set IE = CreateObject("InternetExplorer.Application")
'Set ieObj = New InternetExplorer
IE.Visible = True
URL = "https://www.yellowpages.com/atlanta-ga/attorneys"
'Application.Wait Now + TimeValue("00:00:05")
For page = 2 To 4
If page > 1 Then URLParameter = "?page=" & page
IE.navigate URL & URLParameter
' Wait for the browser to load the page
Do Until IE.readyState = 4
DoEvents
Loop
Set HTML = IE.document
Set links = HTML.getElementsByClassName("info")
For Each htmlELe In links
With ActiveSheet
.Range("A" & i).Value = htmlELe.Children(0).textContent
.Range("B" & i).Value = htmlELe.getElementsByTagName("a")(0).href
.Range("C" & i).Value = htmlELe.Children(2).textContent
.Range("D" & i).Value = htmlELe.Children(2).querySelector("a[href]")
'links2 = htmlELe.getElementsByClassName("links")(1)
' .Range("D" & i).Value = links2.href
End With
i = i + 1
Next htmlELe
Next page
IE.Quit
Set IE = Nothing
End Sub
所需的输出应该是这样的
信息类也用于广告。您首先需要转到类名为“SearchResults organic”的集合,并在其中找到所有“info”类 这意味着您需要一个额外的集合变量:
Set HTML = IE.document
Set OrganicLinks = HTML.getElementsByClassName("search-results organic")
Set links = OrganicLinks.item(0).getElementsByClassName("info")
为了获得正确的网站,你需要使用另一个参考。最好按类名获取,因为该类名更独特:
On Error Resume Next
.Range("B" & i).Value = htmlELe.getElementsByClassName("track-visit-website")(0).href
On Error GoTo 0
我会使用xhr而不是浏览器,将每个页面的数据存储在一个数组中,并将其写入工作表。您确实可以根据每页的结果和页数对一个数组进行尺寸标注,以便提前保存所有结果,但下面的方法仍然有效
Option Explicit
Public Sub GetListings()
Dim html As HTMLDocument, page As Long, html2 As HTMLDocument
Dim results As Object, headers(), ws As Worksheet, i As Long
Const START_PAGE As Long = 1
Const END_PAGE As Long = 2
Set ws = ThisWorkbook.Worksheets("Sheet1")
headers = Array("Name", "Phone", "Website", "Address")
Application.ScreenUpdating = False
Set html = New HTMLDocument
Set html2 = New HTMLDocument
ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
With CreateObject("MSXML2.XMLHTTP")
For page = START_PAGE To END_PAGE
.Open "GET", "https://www.yellowpages.com/atlanta-ga/attorneys?page=" & page, False
.send
html.body.innerHTML = .responseText
Set results = html.querySelectorAll(".organic .result")
Dim output(), r As Long
ReDim output(1 To results.Length, 1 To 4)
r = 1
For i = 0 To results.Length - 1
On Error Resume Next
html2.body.innerHTML = results.item(i).outerHTML
output(r, 1) = html2.querySelector(".business-name").innerText
output(r, 2) = html2.querySelector(".phone").innerText
output(r, 3) = html2.querySelector(".track-visit-website").href
output(r, 4) = html2.querySelector(".street-address").innerText & " " & html2.querySelector(".locality").innerText
On Error GoTo 0
r = r + 1
Next
ws.Cells(GetLastRow(ws, 1) + 1, 1).Resize(UBound(output, 1), UBound(output, 2)) = output
Next
End With
Application.ScreenUpdating = True
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
With ws
GetLastRow = .Cells(.rows.Count, columnNumber).End(xlUp).Row
End With
End Function
输出示例:
您遇到了什么错误?我在网站部门得到了添加,地址字段给出了页面地址。您可以编辑我的代码吗?因为我是vba新手,我将查看并从编辑的代码中学习。它出现了错误“对象不支持此属性或方法”抱歉,小错误。OrganicLinks是一个项目的集合。因此,它需要从第一项中获取信息元素。我改了。你们还有广告吗?我对它进行了测试,更改后它不再显示广告。我刚刚编辑了我的帖子,我需要输出,就像我共享的快照一样。