excel - 无法找出为什么相同的 Excel VBA HTML 代码适用于某些条目而不适用于其他条目

Question

我正在尝试使用 VBA 和 HTML 编码在 Excel 中创建一个电影数据库(我是这个领域的新手)。我的代码如下:

Dim req As New MSXML2.XMLHTTP60
Dim reqURL As String
Dim pelicula As String
Dim Contador As Long
Dim UltimaRow As Long
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim WolTiles As MSHTML.IHTMLElementCollection
Dim WolTile As MSHTML.IHTMLElement
Dim Temporal As Variant
Dim QueSpace As Variant


UltimaRow = Cells(Rows.Count, 1).End(xlUp).Row

For Contador = 2 To UltimaRow
    pelicula = Trim(Range("A" & Contador).Value)
    reqURL = "https://www.filmaffinity.com/us/search.php?stext=" & WorksheetFunction.EncodeURL(pelicula)
    req.Open "GET", reqURL, False
    req.send
    
    HTMLDoc.body.innerHTML = req.responseText
   
    '********* alternative 2
    If req.Status = 200 Then
        Set WolTile = HTMLDoc.getElementById("movie-rat-avg")
        If Not WolTile Is Nothing Then Range("B" & Contador).Value = WolTile.innerText
        Set WolTile = HTMLDoc.getElementById("movie-count-rat")
        If Not WolTile Is Nothing Then Range("C" & Contador).Value = Left(WolTile.innerText, InStr(1, WolTile.innerText, " ") - 1)
        Set WolTiles = HTMLDoc.getElementsByClassName("movie-info")
        If WolTiles.Length = 0 Then
            Range("D" & Contador).Value = 0
        Else
            Temporal = InStr(1, WolTiles.Item(0).innerText, "Year")
            Range("D" & Contador).Value = Mid(WolTiles.Item(0).innerText, Temporal + 4, 4)
            Temporal = InStr(1, WolTiles.Item(0).innerText, "Running time")
            QueSpace = InStr(1, Mid(WolTiles.Item(0).innerText, Temporal + 13, 6), " ")
            Range("E" & Contador).Value = Mid(WolTiles.Item(0).innerText, Temporal + 12, QueSpace)
        End If
        Set WolTiles = HTMLDoc.getElementsByClassName("card-genres")
        If WolTiles.Length = 0 Then
            Range("F" & Contador).Value = 0
        Else
            Temporal = InStr(1, WolTiles.Item(0).innerText, "|")
            QueSpace = InStr(1, WolTiles.Item(0).innerText, ".")
            If Temporal > QueSpace Then
                If QueSpace > 0 Then
                    Range("F" & Contador).Value = Left(WolTiles.Item(0).innerText, QueSpace - 1)
                End If
            Else
                If Temporal > 0 Then
                    Range("F" & Contador).Value = Left(WolTiles.Item(0).innerText, Temporal - 1)
                End If
            End If
        End If
    Else
        MsgBox req.Status & " - " & req.statusText
        Exit Sub
    End If

Next

End Sub

excel 文件 (lista.xlsm) 具有以下用于测试目的的条目:


标题
评分
选票
年
期间
类型


15 分钟 war
5,5
923
2.019
98
戏剧

最后的决斗

0

0

附带美
5,9
9.196
2.016
94

大五血
5,3
3.143
2.020
154
war

丹尼尔不是真的
5,7
1.804
2.019
96
惊悚片


如您所见，“The Last Duel”条目没有显示任何数据。但是，如果我比较 HTML 输出(保存到“HTMLDoc.body.innerHTML = req.responseText”行之后的外部文件，我可以找到相同的元素 ID 和类。
知道为什么会这样吗？

Answer 1

您将获得一个结果列表页面，作为多个可能的匹配项，而不是单个电影列表页面。
您可以检查返回页面的内容以确定您最终选择了哪种类型。
由于默认排序是按相关性排序的，因此您可能会假设结果页面上的第一个电影列表是要使用的，因此发出额外请求以获取该列表的电影页面。
此外，将来您可能需要开发以处理任何结果。

Option Explicit

Public Sub WriteOutFilmInfo()

    Dim req As New MSXML2.XMLHTTP60
    Dim reqURL As String
    Dim pelicula As String
    Dim Contador As Long
    Dim UltimaRow As Long
    Dim HTMLDoc As New MSHTML.HTMLDocument
    Dim WolTiles As MSHTML.IHTMLElementCollection
    Dim WolTile As MSHTML.IHTMLElement
    Dim Temporal As Variant
    Dim QueSpace As Variant

    UltimaRow = Cells(Rows.Count, 1).End(xlUp).Row

    For Contador = 2 To UltimaRow
        pelicula = Trim$(Range("A" & Contador).Value)
        reqURL = "https://www.filmaffinity.com/us/search.php?stext=" & Replace$(pelicula, Chr$(32), "+")
        req.Open "GET", reqURL, False
        req.send
    
        HTMLDoc.body.innerHTML = req.responseText
   
        '********* alternative 2
        If req.Status = 200 Then
            
            If InStr(HTMLDoc.querySelector(".fb-sh").href, ".html&t=") = 0 Then 'on search results list page not specific film page
                 
                 reqURL = HTMLDoc.querySelector(".mc-title > a").href 'extract first listing as default sort is relevance
                 req.Open "GET", reqURL, False
                 req.send
                 HTMLDoc.body.innerHTML = req.responseText
                 
            End If
            
            Set WolTile = HTMLDoc.getElementById("movie-rat-avg")
            If Not WolTile Is Nothing Then Range("B" & Contador).Value = WolTile.innerText
            Set WolTile = HTMLDoc.getElementById("movie-count-rat")
            If Not WolTile Is Nothing Then Range("C" & Contador).Value = Left(WolTile.innerText, InStr(1, WolTile.innerText, " ") - 1)
            
            Set WolTiles = HTMLDoc.getElementsByClassName("movie-info")
            
            If WolTiles.Length = 0 Then
            
                Range("D" & Contador).Value = 0
            
            Else
            
                Temporal = InStr(1, WolTiles.Item(0).innerText, "Year")
                Range("D" & Contador).Value = Mid(WolTiles.Item(0).innerText, Temporal + 4, 4)
                Temporal = InStr(1, WolTiles.Item(0).innerText, "Running time")
                QueSpace = InStr(1, Mid(WolTiles.Item(0).innerText, Temporal + 13, 6), " ")
                Range("E" & Contador).Value = Mid(WolTiles.Item(0).innerText, Temporal + 12, QueSpace)
            
            End If
            
            Set WolTiles = HTMLDoc.getElementsByClassName("card-genres")
            
            If WolTiles.Length = 0 Then
                Range("F" & Contador).Value = 0
            Else
            
                Temporal = InStr(1, WolTiles.Item(0).innerText, "|")
                QueSpace = InStr(1, WolTiles.Item(0).innerText, ".")
                
                If Temporal > QueSpace Then
                
                    If QueSpace > 0 Then
                        Range("F" & Contador).Value = Left(WolTiles.Item(0).innerText, QueSpace - 1)
                    End If
                        
                Else
                
                    If Temporal > 0 Then
                        Range("F" & Contador).Value = Left(WolTiles.Item(0).innerText, Temporal - 1)
                    End If
                    
                End If
            End If
        Else
        
            MsgBox req.Status & " - " & req.statusText
            Exit Sub
            
        End If

    Next

End Sub