Exce VBA - выборка ссылок с веб-сайта по извлечению сборок

Question

Я пытался получить данные из "http://builds.reicast.com/", но проблема в том, что веб-сайт также извлекает информацию (это то, что мне действительно нужно; URL-адреса Master dev-build). Я чувствую, чтозадержка загрузки извлечения Javascript мешает процессу извлечения на моей стороне. Кроме того, я пробовал несколько разных способов извлечения сборочных URL, но они никогда не появляются (я предполагаю, что это та же проблема, что упоминалась ранее).

Вот как это выглядит:

Sub FetchData()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://builds.reicast.com/", Destination:=Range( _
        "$A$1"))
        .Name = "master"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Как я могу получить его для загрузки "раздела master dev-builds"? Спасибо за ваше время!

Answer 1

Вы можете использовать библиотеку элементов управления Microsoft Internet Explorer, добавленную через VBE> Инструменты> Ссылки и включить синхронизированный цикл для обеспечения наличия ссылок, например,

Option Explicit
Public Sub GetLinks()
    Dim ie As New InternetExplorer, commits As Object, t As Date
    Const MAX_WAIT_SEC As Long = 10
    With ie
        .Visible = True
        .Navigate2 "http://builds.reicast.com/"
        While .Busy Or .readyState < 4: DoEvents: Wend
        t = Timer
        Do
            Set commits = ie.document.querySelectorAll(".commit [href]")
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While commits.Length = 0

        Debug.Print commits.Length
        Dim i As Long
        For i = 0 To commits.Length - 1
            With ActiveSheet
                .Cells(i + 1, 1) = commits.item(i).innerText
                .Cells(i + 1, 2) = commits.item(i).getAttribute("href")
            End With
        Next
        Stop '<==Delete me later
        .Quit
    End With
End Sub

---

Если вы хотите выписать всю таблицу:

Option Explicit
Public Sub GetTable()
    Dim ie As New InternetExplorer, hTable As Object, t As Date, headers(), ws As Worksheet
    Const MAX_WAIT_SEC As Long = 10
    headers = Array("Commit", "Date", "Android", "Win_x86", "Win_x64")
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ie
        .Visible = True
        .Navigate2 "http://builds.reicast.com/"
        While .Busy Or .readyState < 4: DoEvents: Wend
        t = Timer
        Do
            On Error Resume Next
            Set hTable = ie.document.querySelector("#builds table")
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While hTable Is Nothing
        Writetable hTable, 1, ws
        ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Quit
    End With
End Sub

Public Sub Writetable(ByVal hTable As Object, ByVal startRow As Long, ByVal ws As Worksheet)
    Dim tr As Object, td As Object, r As Long, c As Long
    For Each tr In hTable.getElementsByTagName("tr")
        r = r + 1: c = 1
        If r > 2 Then
            For Each td In tr.getElementsByTagName("td")
                Select Case c
                Case 1, 3, 4, 5
                    ws.Cells(r - 1, c) = td.FirstChild
                Case Else
                    ws.Cells(r - 1, c) = td.innerText
                End Select
                c = c + 1
            Next
        End If
    Next
End Sub

---

Пример вывода: