Moja skrobak zgłasza błędy zamiast opuścić przeglądarkę, gdy wszystko jest gotowe.

Question

Napisałem skrobak w vba, aby przetworzyć niektóre informacje o filmie z witryny torrent. Użyłem IE i queryselector do wykonania zadania. Kiedy wykonuję mój kod, parsuje wszystko wraz z pojawieniem się błędu. Wygląda na to, że błąd pojawia się znikąd, zamiast kontynuować. Jeśli anuluję okno błędu, wówczas mogę zobaczyć wyniki. Przesłałem dwa zdjęcia poniżej, aby pokazać ci błędy, które mam. Jak mogę pomyślnie wykonać kod bez żadnych błędów? Z góry dziękuję.

Oto pełny kod:

Sub Torrent_Data() 
    Dim IE As New InternetExplorer, html As HTMLDocument 
    Dim post As Object 

    With IE 
     .Visible = False 
     .navigate "https://yts.am/browse-movies" 
     Do While .readyState <> READYSTATE_COMPLETE: Loop 
     Set html = .Document 
    End With 

    For Each post In html.querySelectorAll(".browse-movie-bottom") 
     Row = Row + 1: Cells(Row, 1) = post.queryselector(".browse-movie-title").innerText 
     Cells(Row, 2) = post.queryselector(".browse-movie-year").innerText 
    Next post 
    IE.Quit 
End Sub 

Błędy mam:

Oba błędy pojawiają się w tym samym czasie. Używam przeglądarki Internet Explorer 11.

Z drugiej strony, jeśli spróbuję poniżej, wyniki zostaną pomyślnie zakończone bez żadnych problemów.

Sub Torrent_Data() 
    Dim IE As New InternetExplorer, html As HTMLDocument 
    Dim post As Object 

    With IE 
     .Visible = False 
     .navigate "https://yts.am/browse-movies" 
     Do While .readyState <> READYSTATE_COMPLETE: Loop 
     Set html = .Document 
    End With 

    For Each post In html.getElementsByClassName("browse-movie-bottom") 
     Row = Row + 1: Cells(Row, 1) = post.queryselector(".browse-movie-title").innerText 
     Cells(Row, 2) = post.queryselector(".browse-movie-year").innerText 
    Next post 
    IE.Quit 
End Sub 

referencyjny Dodałem do biblioteki:

1. Microsoft Internet Controls 
2. Microsoft HTML Object Library 

Więc co jest nie tak z queryselector lub co mi brakuje tu aby przejść pomyślnie? Czy jest jakaś wzmianka o dodawaniu do biblioteki, aby pozbyć się błędów?

Answer 1

OK, więc na tej stronie jest coś bardzo nieprzyjaznego. Dla mnie się nie powiodło. Tak więc uciekłem się do uruchomienia programu javascript w ramach silnika skryptów/kontroli skryptów i to działa.

Mam nadzieję, że możesz to zrobić. Logika jest w javascriptu dodanym do ScriptEngine. Dostaję dwie listy węzłów, jedną listę filmów i jedną listę lat; następnie przechodzę przez każdą tablicę zsynchronizowaną i dodajemy ją jako parę wartości klucza do Słownika skryptów Microsoft.

Option Explicit 

'*Tools->References 
'* Microsoft Scripting Runtime 
'* Microsoft Scripting Control 
'* Microsoft Internet Controls 
'* Microsoft HTML Object Library 

Sub Torrent_Data() 
    Dim row As Long 
    Dim IE As New InternetExplorer, html As HTMLDocument 
    Dim post As Object 

    With IE 
     .Visible = True 
     .navigate "https://yts.am/browse-movies" 
     Do While .readyState <> READYSTATE_COMPLETE: 
      DoEvents 
     Loop 
     Set html = .document 
    End With 

    Dim dicFilms As Scripting.Dictionary 
    Set dicFilms = New Scripting.Dictionary 

    Call GetScriptEngine.Run("getMovies", html, dicFilms) 

    Dim vFilms As Variant 
    vFilms = dicFilms.Keys 

    Dim vYears As Variant 
    vYears = dicFilms.Items 

    Dim lRowLoop As Long 
    For lRowLoop = 0 To dicFilms.Count - 1 

     Cells(lRowLoop + 1, 1) = vFilms(lRowLoop) 
     Cells(lRowLoop + 1, 2) = vYears(lRowLoop) 

    Next lRowLoop 

    Stop 

    IE.Quit 
End Sub 

Private Function GetScriptEngine() As ScriptControl 
    '* see code from this SO Q & A 
    ' https://stackoverflow.com/questions/37711073/in-excel-vba-on-windows-how-to-get-stringified-json-respresentation-instead-of 
    Static soScriptEngine As ScriptControl 
    If soScriptEngine Is Nothing Then 
     Set soScriptEngine = New ScriptControl 
     soScriptEngine.Language = "JScript" 

     soScriptEngine.AddCode "function getMovies(htmlDocument, microsoftDict) { " & _ 
            "var titles = htmlDocument.querySelectorAll('a.browse-movie-title'), i;" & _ 
            "var years = htmlDocument.querySelectorAll('div.browse-movie-year'), j;" & _ 
            "if (years.length === years.length) {" & _ 
            "for (i=0; i< years.length; ++i) {" & _ 
            " var film = titles[i].innerText;" & _ 
            " var year = years[i].innerText;" & _ 
            " microsoftDict.Add(film, year);" & _ 
            "}}}" 

    End If 
    Set GetScriptEngine = soScriptEngine 
End Function 

Answer 2

Cóż, wydaje mi się znaleźć rozwiązanie do pracy z .queryselectorAll(). Po wielu eksperymentach mogłem zauważyć, że ma tylko pewne problemy z for loop, więc taktownie uniknąłem for loop i zamiast tego użyłem with block, aby wykonać to samo zadanie. Oto, jak możemy to osiągnąć:

Sub Torrent_Data() 

    With CreateObject("InternetExplorer.Application") 
     .Visible = False 
     .navigate "https://yts.am/browse-movies" 
     While .Busy = True Or .readyState < 4: DoEvents: Wend 

     With .document.querySelectorAll(".browse-movie-bottom") 
      For I = 0 To .Length - 1 
       Cells(I + 1, 1) = .Item(I).querySelector(".browse-movie-title").innerText 
       Cells(I + 1, 2) = .Item(I).querySelector(".browse-movie-year").innerText 
      Next I 
     End With 
    End With 

End Sub 

Btw, powyższy skrypt może zostać wykonany bez odwoływania się do biblioteki.