如何在 Excel 文档中使用 VBA 循环浏览超链接答案

【问题标题】：How to cycle through hyperlinks with VBA in an excel document如何在 Excel 文档中使用 VBA 循环浏览超链接
【发布时间】：2019-06-04 14:08:58
【问题描述】：

我有一个大约的列表。一列中有 160 个 excel 超链接。我正在尝试从每个单独的链接中提取数据。为了导航到特定页面（例如https://www.oddschecker.com/golf/canadian-open/winner/bet-history/dustin-johnson）。

注意。出于测试目的，代码的范围很小。

我认为最好的流程是：

单击并打开每个单独的超链接
拉取资料
关闭网页
重复链接 2
重复链接 3

我在编写将单击并随后从一个链接“循环”到下一个链接的代码时遇到问题，例如从单元格 A6 到单元格 A7。

我尝试过使用涉及 .click 动作的 For each 循环。

不幸的是，我在上述方面没有取得任何成功。

如果可以提供一些帮助，或者如果有人可以指出我自己进一步调查的方向，那将不胜感激。

Public Sub GetReleaseTimes()

Dim ie As Object, hTable As HTMLTable, clipboard As Object, ws2 As Worksheet, ws1 As Worksheet, URL As Range
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ie = CreateObject("InternetExplorer.Application")
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
With ie
    .Visible = True
    .navigate2 
     For Each URL In ws1.Range("A6:A10").Click

        While .Busy Or .readyState < 4: DoEvents: Wend

    Set hTable = .document.querySelector(".eventTable")
    clipboard.SetText hTable.outerHTML
    clipboard.PutInClipboard
    ws2.Range("A1").PasteSpecial
    Next
    .Quit

    End With

End Sub

【问题讨论】：

您的代码未遵循您上面提到的步骤。首先，您需要为 Excel 列使用循环。在循环的每个步骤中，尝试从单元格访问 URL，并尝试创建新的 IE 对象并使用 URL 导航它。比尝试从站点访问详细信息并将其粘贴到工作表并重置 IE 对象。而不是移动到下一个单元格。因此，IE 自动化的所有步骤都应在 Excel 列的循环中完成。您可以尝试修改您的代码，如果您有任何其他问题，请告诉我们。

标签： excel vba internet-explorer web-scraping

【解决方案1】：

请不要点击超链接打开浏览器进行抓取。将链接读入一个数组，循环该数组并 .navigate2 每个 url。

此外，当您从剪贴板粘贴时，您需要每次都找到最后使用的行，而不考虑列，然后在每次旋转的下方粘贴一两行。

Option Explicit

Public Sub GetReleaseTimes()

    Dim ie As Object, hTable As HTMLTable, clipboard As Object
    Dim ws2 As Worksheet, ws1 As Worksheet, urls()

    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ie = CreateObject("InternetExplorer.Application")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    urls = Application.Transpose(ws1.Range("A6:A10").Value)

    With ie
        .Visible = True

        For i = LBound(urls) To UBound(urls)
            .Navigate2 urls(i)
            While .Busy Or .readyState < 4: DoEvents: Wend

            Set hTable = .document.querySelector(".eventTable")
            clipboard.SetText hTable.outerHTML
            clipboard.PutInClipboard
            ws2.Range("A" & GetLastRow(ws2) + 2).PasteSpecial
        Next
        .Quit
    End With
End Sub
Public Function GetLastRow(ByVal sh As Worksheet) As Long
    On Error Resume Next
    GetLastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

【讨论】：