如何使用macros从多个网页提取数据到Excel中

我试图从一个特定的网站提取数据到Excel（2007），但分布在多个网页。 我想在我的工作表中看到的是在本网站上提供哪些项目，而不需要经过多个页面或使用search（在浏览器中有点儿错误）。

我已经尝试通过Excel导入数据，但只适用于一个页面。 由于数据覆盖了183页，我必须做183次才能完成。

我的猜测是，它会用macros来加快速度，但是我没有经验。 我在这个论坛上做了一个search，但是我发现的这个macros可能会给出一个错误，或者只为一个页面做了工作。

有问题的网站的链接是http://www.scalemodelstore.nl/modellen/2/Vliegtuigen.html?&pageID=0

链接中唯一的变化是：pageID = 1，2等等。

提前致谢！

Answer 1

试试这个：

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 

此代码只是获取所有网页上的每个模型的所有可用数据，并将其放入工作表，每个模型一行。 请注意，这不是一个一站式的解决scheme，现在的代码可以工作，但一旦网站内容发生变化，就可能出现问题。