Невозможно исправить проблемы длины при наличии контента - PullRequest
0 голосов
/ 01 марта 2019

Я создал скрипт vba для парсинга некоторых ссылок из таблицы с веб-страницы.Идентификатор, который я использовал в своем скрипте для доступа к таблице, является динамическим, и мне нравится придерживаться этого.В настоящий момент сценарий работает хорошо, если я выберу свой первый подход.Но я не хочу использовать одну и ту же строку Html.querySelectorAll("#DataTables_Table_0 tbody tr") дважды, поэтому я исправил свой первый скрипт, чтобы он был похож на второй.

Но второй подход выдает эту ошибку Invalid use of Null, указывающую наэта строка For i = 0 To elem.Length - 1, тогда как мой первый скрипт все еще использует длину для получения контента.

Мой текущий подход: (рабочий)

Sub GetCardLinks()
    Const timeLimit& = 10
    Const baseUrl = "https://www.psacard.com"
    Dim IE As New InternetExplorer, Html As HTMLDocument
    Dim R&, T As Double, elem As Object

    With IE
        .Visible = True
        .navigate "https://www.psacard.com/psasetregistry/baseball/company-sets/16"
        While .Busy = True Or .readyState < 4: DoEvents: Wend
        Set Html = .document
        T = Timer

        Do
            Set elem = Html.querySelectorAll("#DataTables_Table_0 tbody tr")
            If Timer - T > timeLimit Then Exit Do
            DoEvents
        Loop While elem.Length = 0

        With Html.querySelectorAll("#DataTables_Table_0 tbody tr")
            For i = 0 To .Length - 1
                R = R + 1: Sheets(1).Cells(R, 1) = .Item(i).querySelector("td a[href^='/psasetregistry/baseball/company-sets/']").getAttribute("href")
            Next i
        End With
        .Quit
    End With
End Sub

Мой второй подход: (я не хочу использовать это Html.querySelectorAll("#DataTables_Table_0 tbody tr") дважды)

Sub GetCardLinks()
    Const baseUrl = "https://www.psacard.com"
    Const timeLimit& = 10
    Dim IE As New InternetExplorer, Html As HTMLDocument
    Dim R&, T As Date, elem As Object

    With IE
        .Visible = False
        .navigate "https://www.psacard.com/psasetregistry/baseball/company-sets/16"
        While .Busy = True Or .readyState < 4: DoEvents: Wend
        Set Html = .document
        T = Timer

        Do
            Set elem = Html.querySelectorAll("#DataTables_Table_0 tbody tr")
            If Timer - T > timeLimit Then Exit Do
            DoEvents
        Loop While elem.Length = 0

        For i = 0 To elem.Length - 1
            R = R + 1: ThisWorkbook.Sheets(1).Cells(R, 1) = elem.Item(i).querySelector("td a[href^='/psasetregistry/baseball/company-sets/']").getAttribute("href")
        Next i
        .Quit
    End With
End Sub

Какое возможное изменение я должен сделать, чтобы мой второй подход работал?

1 Ответ

0 голосов
/ 01 марта 2019

Не устанавливайте в переменную html.Отработайте документ.

Option Explicit

Sub GetCardLinks()
    Const baseUrl = "https://www.psacard.com"
    Const timeLimit& = 10
    Dim IE As New InternetExplorer, Html As HTMLDocument
    Dim R&, T As Date, elem As Object, i As Long

    With IE
        .Visible = True
        .navigate "https://www.psacard.com/psasetregistry/baseball/company-sets/16"
        While .Busy = True Or .readyState < 4: DoEvents: Wend
        T = Timer
        Do
            Set elem = .document.querySelectorAll("#DataTables_Table_0 tbody tr")
            If Timer - T > timeLimit Then Exit Do
            DoEvents
        Loop While elem.Length = 0

        For i = 0 To elem.Length - 1
            R = R + 1: ThisWorkbook.Sheets(1).Cells(R, 1) = elem.item(i).querySelector("td a[href^='/psasetregistry/baseball/company-sets/']").getAttribute("href")
        Next i
        .Quit
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...