無法找出為什么相同的ExcelVBAHTML代碼適用于某些條目而不適用于其他條目

我正在嘗試使用 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) 具有以下用于測驗目的的條目：

如您所見，“The Last Duel”條目沒有顯示任何資料。但是，如果我比較 HTML 輸出（在“HTMLDoc.body.innerHTML = req.responseText”行之后保存到外部檔案，我可以找到相同的元素 ID 和類。

知道為什么會這樣嗎？

uj5u.com熱心網友回復：

您將獲得一個結果串列頁面，作為多個可能的匹配項，而不是單個電影串列頁面。

您可以檢查回傳頁面的內容以確定您最終使用的是哪種型別。

由于默認排序是按相關性排序的，因此您可能會假設結果頁面上的第一個電影串列是要使用的，因此發出額外請求以獲取該串列的電影頁面。

此外，將來您可能需要開發以處理無結果。

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

uj5u.com熱心網友回復：

感謝大家！！！你是絕對正確的。我再次檢查，搜索回傳 2 個條目。 在此處輸入圖片說明

標籤：擅长 vba 网页抓取

上一篇：Cardano區塊鏈的嵌套JSON

下一篇：APP+后臺+vue前端全套打包送，電商解決方案CRMEB開源啦