使用VBA宏删除源代码
我需要从价格比较网站(产品链接:)抓取价格值。我刮不动。查看我要捕获的图像中突出显示的价格: 请帮助我如何抓取这一页 PS:toppreise.ch在许多国家/地区都无法访问,因此请使用VPN 我正在使用以下代码:使用VBA宏删除源代码,vba,excel,web-scraping,web-crawler,Vba,Excel,Web Scraping,Web Crawler,我需要从价格比较网站(产品链接:)抓取价格值。我刮不动。查看我要捕获的图像中突出显示的价格: 请帮助我如何抓取这一页 PS:toppreise.ch在许多国家/地区都无法访问,因此请使用VPN 我正在使用以下代码: Private Sub SiteInfo_Click() Dim strhtml On Error Resume Next ThisWorkbook.Sheets("Data Mining").Activate Sheets("Data Mining").Range("B1").S
Private Sub SiteInfo_Click()
Dim strhtml
On Error Resume Next
ThisWorkbook.Sheets("Data Mining").Activate
Sheets("Data Mining").Range("B1").Select
Set xmlHttp = Nothing
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
StrUrl = ""
StrUrl = Sheets("Data Mining").Range("B1").Value
xmlHttp.Open "GET", StrUrl, False
xmlHttp.Send
strhtml =xmlHttp.responseText
END Sub
当我运行上面的代码时,我只得到下面的响应文本。它没有给出整个页面。(您可以使用产品链接或此处的视图检查源代码)
...
此代码有效,谢谢
Sub Get_Price()
Dim HTTP As New XMLHTTP60, HTML As New HTMLDocument
Dim post As HTMLDivElement
With HTTP
.Open "GET", "https://www.toppreise.ch/index.php?a=488002", False
.send
HTML.body.innerHTML = .responseText
End With
For Each post In HTML.getElementsByClassName("altLinesOdd")
With post.getElementsByTagName("a")
If .Length Then R = R + 1: Cells(R, 1) = .Item(0).innerText
End With
With post.getElementsByClassName("spaceVert nobreak")
If .Length Then Cells(R, 2) = .Item(0).innerText
End With
Next post
End Sub
看起来页面是动态的,因此您必须使用不同的方法,例如浏览器自动化。非常感谢@TimWilliams。你能帮忙吗?顺便问一下,如何确定页面是否是动态的?请记住在出现错误时关闭“继续下一步”,并在出现错误时转到0(尽快)。否则您将一直隐藏错误。尝试谷歌搜索“VBA自动IE”,您将获得大量示例。欢迎使用堆栈溢出!感谢您提供此代码片段,它可能会提供一些有限的短期帮助。通过说明为什么这是一个很好的问题解决方案来正确解释它的长期价值,并将使它对未来有其他类似问题的读者更有用。请在您的回答中添加一些解释,包括您所做的假设。
Sub Get_Price()
Dim HTTP As New XMLHTTP60, HTML As New HTMLDocument
Dim post As HTMLDivElement
With HTTP
.Open "GET", "https://www.toppreise.ch/index.php?a=488002", False
.send
HTML.body.innerHTML = .responseText
End With
For Each post In HTML.getElementsByClassName("altLinesOdd")
With post.getElementsByTagName("a")
If .Length Then R = R + 1: Cells(R, 1) = .Item(0).innerText
End With
With post.getElementsByClassName("spaceVert nobreak")
If .Length Then Cells(R, 2) = .Item(0).innerText
End With
Next post
End Sub