VBA WebScraping 一无所获 [英] VBA WebScraping returning nothing to excel

问题描述

正如我之前的问题所示，我一直在尝试从网站上抓取数据.
感谢社区，我能够弄清楚我的问题是什么，但现在我面临另一个问题.
这次我没有收到任何错误，但是程序没有将任何值导出到 excel，我的页面仍然是空白的.
在我抓取的另一个网站上，HTML.Elements 是 divs，现在是 spans，这是因为那个?
这是我的代码:

I've been trying to scrap data from a WebSite, as my previous question indicates.
I was able to figure what my problem was thanks to the comunity, but now I'm facing another problem.
I don't get any error this time, but the program doesn't export any values to excel, my page still all blank.
On the other website I was scraping from, the HTML.Elements were divs and now it's spans, it's because of that?
Here's my code:

Option Explicit
Public Sub Loiça()
    Dim data As Object, i As Long, html As HTMLDocument, r As Long, c As Long, item As Object, div As Object
    Set html = New HTMLDocument                  '<== VBE > Tools > References > Microsoft HTML Object Library

    Dim IE As New InternetExplorer
    Dim numPages As Long
    numPages = GetNumberOfPages

With CreateObject("MSXML2.XMLHTTP")
       ' numResults = arr(UBound(arr))
       ' numPages = 1

        For i = 1 To numPages
             If i > 1 Then
                .Open "GET", Replace$("https://mediamarkt.pt/pages/search-results-page?q=maquina+roupa&page=1", "page=1", "page=" & i), False
                .setRequestHeader "User-Agent", "Mozilla/5.0"
                .send
                 html.body.innerHTML = .responseText
            End If
            Set data = html.getElementsByClassName("snize-title")
            For Each item In data
                r = r + 1: c = 1
                For Each div In item.getElementsByTagName("span")
                    With ThisWorkbook.Worksheets("Loiça")
                        .Cells(r, c) = div.innerText
                    End With
                    c = c + 1
                Next
            Next
        Next
    End With
    '----------------------------------------------------------------------------------------------------------------------------------------------------------------------'
End Sub
Public Function GetNumberOfPages() As Long
    Dim IE As New InternetExplorer
    With IE
        .Visible = False
        .Navigate2 "https://mediamarkt.pt/pages/search-results-page?q=maquina+roupa&page=1"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim numPages As Long, numResults As Long, arr() As String
        arr = Split(.document.querySelector(".snize-search-results-header").innerText, Chr$(32))
        numResults = arr(LBound(arr))
        GetNumberOfPages = numResults
        .Quit
    End With
End Function

推荐答案

信息是动态加载的.您需要始终使用 IE.另外，更改您的 css 选择器

The info is loaded dynamically. You need to use IE throughout. Also, change your css selector

Option Explicit

Public Sub WriterResults()
    Dim IE As New InternetExplorer, i As Long, data As Object, span As Object, item As Object, r As Long, c As Long
    With IE
        .Visible = True
        .Navigate2 "https://mediamarkt.pt/pages/search-results-page?q=maquina+roupa&page=1"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim numPages As Long, numResults As Long, arr() As String
        arr = Split(.document.querySelector(".snize-search-results-header").innerText, Chr$(32))
        numResults = arr(LBound(arr))
        Dim resultsPerPage As Long
        resultsPerPage = .document.querySelectorAll(".snize-overhidden").Length
        numPages = Application.RoundUp(numResults / resultsPerPage, 0)
        For i = 1 To numPages
            If i > 1 Then
                .Navigate2 Replace$("https://mediamarkt.pt/pages/search-results-page?q=maquina+roupa&page=1", "page=1", "page=" & i)
                While .Busy Or .readyState < 4: DoEvents: Wend
            End If
            Set data = .document.getElementsByClassName("snize-overhidden")
            For Each item In data
                r = r + 1: c = 1
                For Each span In item.getElementsByTagName("span")
                    With ThisWorkbook.Worksheets("Loiça")
                        .Cells(r, c) = span.innerText
                    End With
                    c = c + 1
                Next
            Next
        Next
        .Quit
    End With
End Sub

这篇关于VBA WebScraping 一无所获的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！