Question

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

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

我认为最好的过程是：

单击并打开每个单独的超链接
提取信息
关闭网页
重复链接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

Answer 1

请不要单击超链接以打开浏览器进行抓取。将链接读取到一个数组中，循环该数组，并每个URL分别添加.navigate2。

此外，从剪贴板粘贴时，您需要每次都找到最后使用的行，而与列无关，然后每转一圈在其下方粘贴一两行。

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

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

1 个答案: