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

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

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

我认为最好的过程是：

1. 单击并打开每个单独的超链接
2. 拉取信息
3. 关闭网页
4. 重复链接 2
5. 重复链接 3

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

我尝试过尝试涉及 .click 操作的 For every 循环。

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

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

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

请不要点击超链接打开浏览器进行抓取。将链接读入数组，循环该数组并 .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