gpt4 book ai didi

vba - 使用 VBA-Macros 抓取源代码

转载 作者:行者123 更新时间:2023-12-04 20:55:28 24 4
gpt4 key购买 nike

我需要从比价网站(产品链接:https://www.toppreise.ch/prod_488002.html)抓取价格值。我不能刮。查看我要捕获的图像中突出显示的价格:

click to see image

请帮助我如何抓取此页面。

PS:toppreise.ch 在许多国家/地区将无法访问,因此请使用 VPN

我正在使用以下代码:

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

当我在上面运行代码时,我只得到下面的响应文本。它没有给出整个页面。 (您可以通过产品链接查看源代码或查看 https://www.dropbox.com/s/ah80jt7a25xcicp/source%20code.txt?dl=0)
<html><head>
<script type="text/javascript" src="//en.toppreise.ch/js/tpjs.js"></script>
<script type="text/javascript" src="//en.toppreise.ch/js/afxp.js"></script>
<script type="text/javascript" src="//en.toppreise.ch/js/jquery.min.js"></script>
<script type="text/javascript" src="//en.toppreise.ch/js/jquery-ui-autocomplete.min.js"></script>
</head><body>...

最佳答案

此代码有效,谢谢 SIM

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

关于vba - 使用 VBA-Macros 抓取源代码,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/48800813/

24 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com