【发布时间】:2019-07-28 00:40:40
【问题描述】:
问题:
我一直在尝试从网站上抓取数据,但它总是给我一个错误 Subscript OutOf Range。我不知道为什么。我在另一个网站上使用完全相同的代码,它工作得非常好。
是的,我已将 divs 更改为我想从中抓取的新网站。
代码:
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
Const START_URL As String = "https://mediamarkt.pt/pages/search-results-page?q=maquina+roupa&page=1"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", START_URL, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
html.body.innerHTML = .responseText
Dim numPages As Long, numResults As Long, arr() As String
arr = Split(html.querySelector(".snize-search-results-header").innerText, Chr$(32))
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-four-columns")
For Each item In data
r = r + 1: c = 1
For Each div In item.getElementsByTagName("div")
With ThisWorkbook.Worksheets("Loiça")
.Cells(r, c) = div.innerText
End With
c = c + 1
Next
Next
Next
End With
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------'
End Sub
【问题讨论】:
-
错误出现在哪一行?
-
@QHarr 错误发生在第 15 行
numResults = arr(UBound(arr))
标签: excel vba web-scraping screen-scraping