vba - 我正在尝试创建一个宏，将 IMDB.com 的评分和总评论提取到一个 excel 文件中

Question

我的工作表中有一个电影列表，范围从 A2:A966 开始，我正试图让这个过程正常工作，但是我的代码出现运行时错误 91。现在它要求以以下形式为电影命名一个输入框(从尽可能多的资源中提取，但我发现最有用的教程使用了一个输入框)但理想情况下，它只会遍历 A2:A966 中的电影列表并将收视率数据拉入 B2 :966 和 C2:C966 的总评级

Sub test()
    Dim eRow As Long
    Dim ele As Object
    Dim RowCount As Integer

    Set sht = Sheets("Sheet1")
    RowCount = 1
    sht.Range("A" & RowCount) = "IMDB Rating"
    sht.Range("B" & RowCount) = "Total Reviews"
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Set objIE = CreateObject("InternetExplorer.Application")
    'strSearch = Range("A2")
    moviename = InputBox("Enter movie name")

    With objIE
        .Visible = True
        .navigate "http://www.imdb.com/"

        Do While .Busy Or _
          .readystate <> 4
            DoEvents
        Loop

        Set nam = .document.getElementsByName("navbar-query")
        nam.Item(0).Value = moviename

        .document.getElementsByID("navbar-submit-button").Click
        .document.getElementsByID("result_text").Click

        Do While .Busy Or _
          .readystate <> 4
            DoEvents
        Loop

        For Each ele In .document.all
            Select Case ele.classname
                Case "Result"
                    RowCount = RowCount + 1
                Case "ratingValue"
                    sht.Range("A" & RowCount) = ele.innertext
                Case "ratingCount"
                    sht.Range("B" & RowCount) = ele.innertext
            End Select
        Next ele
    End With

    Set objIE = Nothing
End Sub

Answer 1

有几种方法可以实现这一目标。这是其中之一。搏一搏:

Sub imd_data()

    Dim IE As New InternetExplorer, html As HTMLDocument, ele As Object

    With IE
        .Visible = True
        .navigate "http://www.imdb.com/"
        Do Until .readyState = READYSTATE_COMPLETE: Loop
        Set html = .document
    End With

    html.getElementById("navbar-query").Value = "Blood Diamond"
    html.getElementById("navbar-submit-button").Click
    Application.Wait Now + TimeValue("00:00:05")
    html.getElementsByClassName("result_text")(0).getElementsByTagName("a")(0).Click
    Application.Wait Now + TimeValue("00:00:05")

    For Each ele In html.getElementsByClassName("imdbRating")
        With ele.getElementsByClassName("ratingValue")
            If .Length Then r = r + 1: Cells(r, 1) = .Item(0).innerText
        End With
        With ele.getElementsByClassName("small")
            If .Length Then Cells(r, 2) = .Item(0).innerText
        End With
    Next ele

    IE.Quit
End Sub

输出:

8.0/10  434,144