Scraper throws errors instead of quitting the browser when everything is done

后端 未结 2 388
一整个雨季
一整个雨季 2021-01-11 15:49

I\'ve written a scraper to parse movie information from a torrent site. I used IE and queryselector.

My code does parse everything. It thro

2条回答
  •  庸人自扰
    2021-01-11 16:08

    The website has an API. Check e. g. result from the URL https://yts.am/api/v2/list_movies.json?page=1&limit=50, which actually represents 50 movies from first page of latest movies category, in JSON format.

    Take a look at the below example. Import JSON.bas module into the VBA project for JSON processing.

    Option Explicit
    
    Sub Test()
    
        Dim sJSONString As String
        Dim vJSON
        Dim sState As String
        Dim lPage As Long
        Dim aRes()
        Dim i As Long
        Dim aData()
        Dim aHeader()
    
        With Sheets(1)
            .Cells.Delete
            .Cells.WrapText = False
        End With
        lPage = 1
        aRes = Array()
        Do
            With CreateObject("MSXML2.XMLHTTP")
                .Open "GET", "https://yts.am/api/v2/list_movies.json?page=" & lPage & "&limit=50", False
                .send
                sJSONString = .responseText
            End With
            JSON.Parse sJSONString, vJSON, sState
            If Not vJSON("data").Exists("movies") Then Exit Do
            vJSON = vJSON("data")("movies")
            ReDim Preserve aRes(UBound(aRes) + UBound(vJSON) + 1)
            For i = 0 To UBound(vJSON)
                Set aRes(UBound(aRes) - UBound(vJSON) + i) = vJSON(i)
            Next
            lPage = lPage + 1
            Debug.Print "Parsed " & (UBound(aRes) + 1)
            DoEvents
        Loop
        JSON.ToArray aRes, aData, aHeader
        With Sheets(1)
            OutputArray .Cells(1, 1), aHeader
            Output2DArray .Cells(2, 1), aData
            .Columns.AutoFit
        End With
        MsgBox "Completed"
    
    End Sub
    
    Sub OutputArray(oDstRng As Range, aCells As Variant)
    
        With oDstRng
            .Parent.Select
            With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
                .NumberFormat = "@"
                .Value = aCells
            End With
        End With
    
    End Sub
    
    Sub Output2DArray(oDstRng As Range, aCells As Variant)
    
        With oDstRng
            .Parent.Select
            With .Resize( _
                    UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                    UBound(aCells, 2) - LBound(aCells, 2) + 1)
                .NumberFormat = "@"
                .Value = aCells
            End With
        End With
    
    End Sub
    

    The output for me as follows, at the moment there are 7182 movies total:

    BTW, the similar approach applied in other answers.

提交回复
热议问题