如何使用VBA一次刮取多个页面链接？

Question

我正在尝试从以下网页中提取信息 这个Reddit页面. 我的目标是让excel在新的标签页中打开所有的帖子，然后我想从每一个页面中刮取信息，因为起始页没有那么多信息。

在过去的几个小时里，我一直在尝试解决这个问题，但我承认我对如何做很困惑，只是总体上不知道下一步该怎么做，所以任何提示都将是非常感激的。

这是我现在的代码，它的工作原理已经很不错了，但正如我所说，我不知道下一步应该怎么做，把它找到的链接一个个打开，然后把每个页面的数据搜刮出来。现在，链接是从第一页上刮下来的，然后添加到我的电子表格中，但如果可能的话，我想直接跳过这一步，一次性把它们全部刮下来。

谢谢你 :)

Sub GetData()

Dim objIE As InternetExplorer
Dim itemEle As Object
Dim upvote As Integer, awards As Integer, animated As Integer
Dim postdate As String, upvotepercent As String, oc As String, filetype As String, linkurl As String, myhtmldata As String, visiComments As String, totalComments As String, removedComments As String
Dim y As Integer

Set objIE = New InternetExplorer
objIE.Visible = False

objIE.navigate (ActiveCell.Value)
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

y = 1

For Each itemEle In objIE.document.getElementsByClassName("flat-list buttons")
visiComments = itemEle.getElementsByTagName("a")(0).innerText
linkurl = itemEle.getElementsByTagName("a")(0).href
Sheets("Sheet1").Range("A" & y).Value = visiComments
Sheets("Sheet1").Range("B" & y).Value = linkurl
y = y + 1
Next

End Sub

Answer 1

你应该能收集到URL，然后在循环中访问，并将结果从访问的页面写到数组，然后数组到工作表。在你现有的行后添加以下内容

Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

添加。

Dim nodeList As Object , i As Long, urls(), results()

注意：你只是在页面加载上有潜在的收益，因为VBA是单线程的。要做到这一点，你需要存储每个标签页的引用，或者先打开所有的标签页，然后循环通过相关的打开窗口来进行刮擦。说实话，我的偏好是保持在同一个标签页中。

Set nodeList = ie.document.querySelectorAll(".comments")
Redim urls(0 To nodeList.Length-1)
Redim results(1 to nodeList.Length, 1 to 3)
'Store all urls in an array to later loop
For i = 0 To nodeList.Length -1 
    urls(i) = nodeList.item(i).href
Next

For i = LBound(urls) To UBound(urls)
    ie.Navigate2   urls(i)
    While ie.Busy Or ie.Readystate <> 4: DoEvents:Wend
    'may need a pause here
    results(i + 1, 1) = ie.document.querySelector("a.title").innerText 'title
    results(i + 1, 2) = ie.document.querySelector(".number").innerText 'upvotes
    results(i + 1, 3) = ie.document.querySelector(".word").NextSibling.nodeValue '%
Next
ActiveSheet.Cells(1,1).Resize(UBound(results,1) , UBound(results,2)) = results