html - VBA WebScraping 没有返回 excel
问题描述
正如我之前的问题所表明的那样,我一直在尝试从网站上抓取数据。
感谢社区,我能够弄清楚我的问题是什么,但现在我面临另一个问题。
这次我没有收到任何错误,但是程序没有将任何值导出到 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
解决方案
信息是动态加载的。您需要始终使用 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
推荐阅读
- python-3.x - 如何使用 Pytorch 中保存的模型来预测从未见过的图像的标签?
- java - 错误:必须声明一个命名包,因为此编译单元与命名模块“*******”相关联
- c# - 如何停止在另一个线程中创建的循环
- python - 没有循环的元组的元组索引列表
- javascript - 使用 DevTools 在网站上运行脚本
- d3.js - crossfilter 下拉过滤器和折线图不能一起工作
- javascript - JavaScript If 条件语句不筛选输入值
- c# - .net core AspnetCore Razor 视图因 CompilationFailedException 而失败
- npm - 针对不同的环境有不同的 vue 配置
- android - 更改图层列表中的形状渐变起始颜色