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

问题描述

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

I have a list of circa. 160 hyperlinks within excel in a column. I am attempting to pull the data from each of these individual links. In order to navigate to specific pages (e.g. https://www.oddschecker.com/golf/canadian-open/winner/bet-history/dustin-johnson).

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

nb. the range of the code is small for testing purposes.

我认为最好的过程是:

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

我在编写代码时遇到了麻烦，该代码将单击并随后从一个链接循环"到下一个链接，例如从单元格A6到单元格A7.

I am having trouble writing the code that will click and subsequently 'cycle' from one link to the next e.g. from cell A6, to cell A7.

我尝试了一个涉及.click动作的For Each循环.

I have tried experimenting with a For each loop involving .click actions.

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

Unfortunately, I haven't had any success with the above.

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

If some assistance could be provided, or if someone could kindly point me in a direction to investigate further myself, that would be much appreciated.

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网址.

Please don't click on hyperlinks to open browser for scraping. Read the links into an array, loop that array and .navigate2 each url.

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

Also, as your pasting from clipboard you need to find the last used row, irrespective of column, each time, and then paste a row or two below that each revolution.

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循环浏览超链接的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！