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

时间:2014-09-12 21:36:04

标签: excel vba excel-vba

我试图从一个特定网站将数据提取到Excel(2007)中,但是分布在多个网页上。我希望在我的工作表中看到的是这个网站上提供的项目,没有经过多个页面或使用搜索(在我的浏览器中有点错误)。

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

我的猜测是它可以更快地使用宏,但我没有经验。 我在这个论坛上进行了搜索,但是我发现的宏会发出错误或只为一页做了工作。

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

链接中唯一的变化是在最后:pageID = 1,2等等。

提前致谢!

1 个答案:

答案 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

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