VBA WebScraping ничего не дает, чтобы превзойти - PullRequest
Новая
       16

VBA WebScraping ничего не дает, чтобы превзойти

0 голосов
/ 06 марта 2019

Я пытался удалить данные с веб-сайта, как показывает мой предыдущий вопрос.
Я смог понять, в чем заключалась моя проблема, благодаря сообществу, но теперь я столкнулся с другой проблемой.
На этот раз я не получаю никакой ошибки, но программа не экспортирует никаких значений в Excel, моя страница все еще пуста.
На другом веб-сайте, с которого я работал, HTML.Elements были divs, и теперь это spans, это из-за этого?
Вот мой код: 

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

1 Ответ

4 голосов
/ 06 марта 2019

Информация загружается динамически. Вы должны использовать IE во всем. Также измените ваш css селектор 

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
...