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
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.