How to extract data from multiple webpages into Excel with a macro

前端 未结 1 1045
名媛妹妹
名媛妹妹 2021-01-03 16:30

I\'m trying to extract data into Excel (2007) from one specific website, but spread over multiple webpages. What I want to see in my sheet is which items are offered on this

相关标签:
1条回答
  • 2021-01-03 16:55

    Try this one:

    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
    

    This code just gets all available data for each model on all webpages and put it into worksheet, one row for each model. Note, it is not a one-stop solution, the code works now, but may become faulty as soon as the website content changed.

    0 讨论(0)
提交回复
热议问题