使用Excel VBA从网站上刮取文字？

I am quite new to using Excel as a webpage scraper, but I found this very interesting article explaining how to scrape certain tags from a website using Excel VBA. I have the code below which works fine but it only gets the content from the first <p> tag that it finds:

我很擅长使用Excel作为网页抓取工具,但我发现这篇非常有趣的文章解释了如何使用Excel VBA从网站上抓取某些标签。我有下面的代码工作正常,但它只从它找到的第一个

标签获取内容:

Sub get_title_header()
Dim wb As Object
Dim doc As Object
Dim sURL As String
Dim lastrow As Long
lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To lastrow
Set wb = CreateObject("internetExplorer.Application")
sURL = Cells(i, 1)

wb.navigate sURL
wb.Visible = True

While wb.Busy
    DoEvents
Wend

'HTML document
Set doc = wb.document

Cells(i, 2) = doc.title

On Error GoTo err_clear
Cells(i, 3) = doc.GetElementsByTagName("p")(0).innerText
err_clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
wb.Quit
Range(Cells(i, 1), Cells(i, 3)).Columns.AutoFit
Next i

End Sub

Now what I'd like to do is adjust the code and make the scraper get all the content that is within a <p> tag on a webpage. So I guess a foreach functionality of some kind is missing.

现在我要做的是调整代码并让刮刀获取网页上

标签内的所有内容。所以我猜想某种foreach功能缺失了。

Hopefully someone here is willing to help me out to extend the code, so that the content from multiple <p> tags will be collected.

希望有人愿意帮助我扩展代码,以便收集来自多个

标签的内容。

UPDATE Below the working code!

更新工作代码下方!

Sub get_title_header()
Dim wb As Object
Dim doc As Object
Dim sURL As String
Dim lastrow As Long
Dim i As Integer
lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To lastrow
Set wb = CreateObject("internetExplorer.Application")
sURL = Cells(i, 1)

wb.navigate sURL
wb.Visible = True

While wb.Busy
    DoEvents
Wend

'HTML document
Set doc = wb.document

Cells(i, 2) = doc.Title

On Error GoTo err_clear

Dim el As Object
For Each el In doc.GetElementsByTagName("p")

counter = counter + 1
    Cells(i, counter + 2).Value = Cells(counter + 1).Value & el.innerText

Next el
counter = 0

err_clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
wb.Quit
Range(Cells(i, 1), Cells(i, 10)).Columns.AutoFit
Next i

End Sub

1 个解决方案

#1

You're almost there! doc.GetElementsByTagName("p") returns a collection of HTMLParagraphElement objects of which you accessed the first entry using doc.GetElementsByTagName("p")(0). As you allude to, a For Each loop would let you access each in turn:

你快到了! doc.GetElementsByTagName(“p”)返回HTMLParagraphElement对象的集合,您使用doc.GetElementsByTagName(“p”)(0)访问了第一个条目。正如您所提到的,For Each循环允许您依次访问每个循环:

Sub get_title_header()
Dim wb As Object
Dim doc As Object
Dim sURL As String
Dim lastrow As Long
Dim i As Integer
lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To lastrow
Set wb = CreateObject("internetExplorer.Application")
sURL = Cells(i, 1)

wb.navigate sURL
wb.Visible = True

While wb.Busy
    DoEvents
Wend

'HTML document
Set doc = wb.document

Cells(i, 2) = doc.Title

On Error GoTo err_clear

Dim el As Object
For Each el In doc.GetElementsByTagName("p")
    Cells(i, 3).Value = Cells(i, 3).Value & ", " & el.innerText
Next el

err_clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
wb.Quit
Range(Cells(i, 1), Cells(i, 3)).Columns.AutoFit
Next i

End Sub