How to cycle through hyperlinks with VBA in an exc

问题:

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. the range of the code is small for testing purposes.

I think the best process would be to:

1. Click & Open each individual hyperlink
2. Pull the information
3. Close the webpage
4. Repeat for link 2
5. Repeat for link 3

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.

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

回答1:

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