Как перебирать гиперссылки с VBA в документе Excel

Question

У меня есть список около. 160 гиперссылок в Excel в столбце. Я пытаюсь получить данные из каждой из этих отдельных ссылок. Для перехода на определенные страницы (например, https://www.oddschecker.com/golf/canadian-open/winner/bet-history/dustin-johnson).

пь. диапазон кода невелик для целей тестирования.

Я думаю, что лучшим процессом будет:

1. Нажмите и откройте каждую отдельную гиперссылку
2. Вытащить информацию
3. Закрыть веб-страницу
4. Повторите для ссылки 2
5. Повторите для ссылки 3

У меня проблемы с написанием кода, который будет щелкать, а затем «переходить» с одной ссылки на другую, например. из ячейки A6 в ячейку A7.

Я попытался поэкспериментировать с циклом «Для каждого», включающим действия .click.

К сожалению, у меня не было никакого успеха с вышеупомянутым.

Если бы могла быть оказана некоторая помощь или кто-то мог бы любезно указать мне направление дальнейшего расследования, я был бы очень признателен.

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

Пожалуйста, не нажимайте на гиперссылки, чтобы открыть браузер для просмотра. Прочитайте ссылки в массив, зациклите этот массив и .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