Excel data import in specific cell

Question

I would like to list up devices and put their prices next to them.

My goal is to check different sites every week and notice trends.

This is a hobby project, I know there are sites that already do this.

For instance:

Device    | URL Site 1  | Site 1  | URL Site 2  | Site 2 
Device a  | http://...  | €40,00  | http://...  | €45,00
Device b  | http://...  | €28,00  | http://...  | €30,50

Manually, this is a lot of work (checking every week), so I thought a Macro in Excel would help. The thing is, I would like to put the data in a single cell and excel only recognises tables. Solution: view source code, read price, export price to specific cell.

I think this is all possible within Excel, but I can't quiet figure out how to read the price or other given data and how to put it in one specific cell. Can I specify coordinates in the source code, or is there a more effective way of thinking?

Answer 1

First of all you have to find out how does the website works. For the page you asked I have done the following:

• Opened http://www.mediamarkt.de page in Chrome.
• Typed BOSCH WTW 85230 in the search box, suggestion list appeared.
• Pressed F12 to open developer tools and clicked Network tab.
• Each time I was typing, the new request appeared (see yellow areas):

• Clicked the request to examine general info:

You can see that it uses GET method and some parameters including url-encoded product name.

• Clicked the Response tab to examine the data returning from the server:

You can see it is a regular JSON, full content is as follows:

{"suggestions":[{"attributes":{"energyefficiencyclass":"A++","modelnumber":"2004975","availabilityindicator":"10","customerrating":"0.00000","ImageUrl":"http://pics.redblue.de/artikelid/DE/2004975/CHECK","collection":"shop","id":"MediaDEdece2358813","currentprice":"444.00","availabilitytext":"Lieferung in 11-12 Werktagen"},"hitCount":0,"image":"http://pics.redblue.de/artikelid/DE/2004975/CHECK","name":"BOSCH WTW 85230 Kondensationstrockner mit Warmepumpentechnologie (8 kg, A++)","priority":9775,"searchParams":"/Search.ff?query=BOSCH+WTW+85230+Kondensationstrockner+mit+W%C3%A4rmepumpentechnologie+%288+kg%2C+A+%2B+%2B+%29\u0026channel=mmdede","type":"productName"}]}

Here you can find "currentprice":"444.00" property with the price.

• Simplified the request by throwing out some optional parameters, it turned out that the same JSON response can be received by the URL http://www.mediamarkt.de/FACT-Finder/Suggest.ff?channel=mmdede&query=BOSCH+WTW+85230
• That data was enough to built some code, assuming that first column intended for products:

Option Explicit

Sub TestMediaMarkt()

    Dim oRange As Range
    Dim aResult() As String
    Dim i As Long
    Dim sURL As String
    Dim sRespText As String

    ' set source range with product names from column A
    Set oRange = ThisWorkbook.Worksheets(1).Range("A1:A3")
    ' create one column array the same size
    ReDim aResult(1 To oRange.Rows.Count, 1 To 1)
    ' loop rows one by one, make XHR for each product
    For i = 1 To oRange.Rows.Count
        ' build up URL
        sURL = "http://www.mediamarkt.de/FACT-Finder/Suggest.ff?channel=mmdede&query=" & EncodeUriComponent(oRange.Cells(i, 1).Value)
        ' retrieve HTML content
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", sURL, False
            .Send
            sRespText = .responseText
        End With
        ' regular expression for price property
        With CreateObject("VBScript.RegExp")
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            .Pattern = """currentprice""\:""([\d.]+)""" ' capture digits after 'currentprice' in submatch
            With .Execute(sRespText)
                If .Count = 0 Then ' no matches, something going wrong
                    aResult(i, 1) = "N/A"
                Else ' store the price to the array from the submatch
                    aResult(i, 1) = .Item(0).Submatches(0)
                End If
            End With
        End With
    Next
    ' output resultion array to column B
    Output Sheets(1).Range("B1"), aResult

End Sub

Function EncodeUriComponent(strText)
    Static objHtmlfile As Object
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
    End If
    EncodeUriComponent = objHtmlfile.parentWindow.encode(strText)
End Function

Sub Output(oDstRng As Range, aCells As Variant)
    With oDstRng
        .Parent.Select
        With .Resize( _
            UBound(aCells, 1) - LBound(aCells, 1) + 1, _
            UBound(aCells, 2) - LBound(aCells, 2) + 1 _
        )
            .NumberFormat = "@"
            .Value = aCells
            .Columns.AutoFit
        End With
    End With
End Sub

• Filled worksheet with some product names:

• Launched the sub and got the result:

It is just the example how to retrieve a data from the website via XHR and parse a response with RegExp, I hope it helps.