我试图从一个特定网站将数据提取到Excel(2007)中,但是分布在多个网页上。我希望在我的工作表中看到的是这个网站上提供的项目,没有经过多个页面或使用搜索(在我的浏览器中有点错误)。
我尝试通过Excel导入数据,但这只适用于一个页面。由于数据覆盖了183页,我必须完成183次才能完成。
我的猜测是它可以更快地使用宏,但我没有经验。 我在这个论坛上进行了搜索,但是我发现的宏会发出错误或只为一页做了工作。
相关网站的链接是http://www.scalemodelstore.nl/modellen/2/Vliegtuigen.html?&pageID=0
链接中唯一的变化是在最后:pageID = 1,2等等。
提前致谢!
答案 0 :(得分:2)
试试这个:
Sub GetData()
Dim lRow, lPage, oXmlHttp, sResp, aResp, sPart, oHtmlFile, oBody, sInText, aInLines, lCol, sLineText, aImgPts
lRow = 1
lPage = 0
Do
sUrl = "http://www.scalemodelstore.nl/modellen/2/Vliegtuigen.html?&pageID=" & lPage
Do
Set oXmlHttp = CreateObject("MSXML2.XMLHttp")
oXmlHttp.Open "GET", sUrl, True
oXmlHttp.Send
Do Until oXmlHttp.ReadyState = 4
DoEvents
Loop
sResp = oXmlHttp.ResponseText
Loop While sResp = ""
aResp = Split(sResp, "<a class=""productTile"" ")
For i = 1 To UBound(aResp)
sPart = "<a " & aResp(i)
sPart = Split(sPart, "</a>")(0)
Set oHtmlFile = CreateObject("htmlfile")
oHtmlFile.Write sPart
Set oBody = oHtmlFile.GetElementsByTagName("body")(0)
sInText = Trim(oBody.InnerText)
aInLines = Split(sInText, vbCrLf)
lCol = 1
For Each sLineText In aInLines
sLineText = Trim(sLineText)
If sLineText <> "" Then
Cells(lRow, lCol).Value = sLineText
lCol = lCol + 1
End If
Next
aImgPts = Split(sPart, "<img src=""")
If UBound(aImgPts) > 0 Then
Cells(lRow, lCol).Value = Split(aImgPts(1), """")(0)
End If
lRow = lRow + 1
Next
lPage = lPage + 1
Loop Until UBound(aResp) = 0
End Sub
此代码只获取所有网页上每个模型的所有可用数据,并将其放入工作表中,每个模型一行。请注意,它不是一站式解决方案,代码现在可以使用,但一旦网站内容发生变化就可能出现故障。