Scraping on Amazon Now Prime postcode entry

I am trying to enter a postcode on primenow.amazon.co.uk and find if what delivery services they offer. I have made some progress with the script. Can anyone help me move it to the finish?

The part i'm struggling with is:

'assigning the input variables to the html elements of the form
ie.Document.getElementsByClassName("prime-now-input clearfix")(0).innerHTML = Postcode

'click
ie.Document.getElementsByClassName("pull-right")(0).click

Doesn't seem to work fully. Any other methods?

Full code:

Sub PostCode_Delivery()

Dim ie As Object
Dim ws As Excel.Worksheet
Dim i As Long

Set ie = CreateObject("InternetExplorer.Application")
Set ws = ThisWorkbook.Worksheets("Postcodes")
i = 1

Do While ws.Cells(i, 1).Value <> ""

With ie
    .Visible = True
    .Navigate ("primenow.amazon.co.uk")

'we ensure that the web page downloads completely before we fill the form automatically
While ie.ReadyState <> 4
   DoEvents
Wend

Postcode = ws.Cells(i, 1).Value

'assigning the vinput variables to the html elements of the form
ie.Document.getElementsByClassName("prime-now-input clearfix")(0).innerHTML = Postcode

'click
ie.Document.getElementsByClassName("pull-right")(0).click

'again ensuring that the web page loads completely before we start scraping data
Do While ie.Busy: DoEvents: Loop

Set OutputResult = ie.Document.getElementsByClassName("availability__form__instructions__heading")(0).Value

ws.Cells(i, 2).Value = OutputResult(0).textContent

Application.StatusBar = "Number: " & i
i = i + 1
End With
Loop

ie.Quit

'cleaning up memory
Set ie = Nothing

End Sub

Answers


Most of the times when the website is as dynamic as this one getting the HTML objects is a lot of work. Also using the Internet explorer is not the fastest of the solutions since we have to wait for the page to reload in most cases.

This is an alternative to getting the data. Do not be scared by the code it's just that I am using quite a few functions to help me along the way.

The idea is to send a Http request and parse the data that was returned in JSON format.

Option Explicit

Dim oScript As Object
Dim oHttp As Object

Sub MainRunner()

    Const strAVAILABILITY As String = "https://primenow.amazon.co.uk/fulfillment/availability/"

    Dim ws As Worksheet
    Dim i As Long

    'Initalize variables
    Set ws = ThisWorkbook.Worksheets("Postcodes")
    Set oScript = CreateObject("MSScriptControl.ScriptControl")
    oScript.Language = "JScript"
    Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

    ' Loop through every cell.
    i = 1
    Do While ws.Cells(i, 1).Value <> vbNullString
        ws.Cells(i, 2).Value = GetData(strAVAILABILITY & ws.Cells(i, 1).Value)
        i = i + 1
    Loop

End Sub

' Retrieves the data using an http request
Function GetData(ByVal strUrl As String) As String

    Dim oJson As Object
    Dim oAvailability As Object

    ' Encode the URl in case there are special chars
    strUrl = EncodeURL(strUrl)

    ' Prepare the Http Request
    oHttp.Open "GET", strUrl, False
    oHttp.send

    If oHttp.Status = 200 Then

        ' Get the JSON object returned
        Set oJson = GetJSonObject(oHttp.responseText)

        If Not oJson Is Nothing Then
            Set oAvailability = GetObjectProperty(oJson, "availability")
            If Not oAvailability Is Nothing Then
                ' Return the information in a string
                GetData = ParseAvailabilty(oAvailability)
            End If
        End If
    End If

End Function

' Parse the results into a string.
Function ParseAvailabilty(oAvailabilty As Object) As String

    Dim varFinal() As Variant
    Dim varData As Variant
    Dim i As Long

    varData = GetPropertyKeys(oAvailabilty)
    ReDim varFinal(UBound(varData))

    For i = LBound(varData) To UBound(varData)
        varFinal(i) = varData(i) & ":" & GetProperty(oAvailabilty, varData(i))
    Next i

    'Return the value
    ParseAvailabilty = Join(varFinal, ", ")

End Function

' Gets a json object
Public Function GetJSonObject(ByVal strJson As String) As Object

     Dim ret As Object

    ' We wrap it in an error reseum next incase is could not
    ' be parsed
    On Error Resume Next
    Set ret = oScript.Eval("(" & strJson & ")")
    On Error GoTo 0

    ' Return the value
    Set GetJSonObject = ret

End Function

' Encode URL
Public Function EncodeURL(ByVal URL As String) As Variant

    Const strFUNCTION As String = "function encode(o) { return encodeURI(o);}"

    oScript.AddCode strFUNCTION
    EncodeURL = oScript.Run("encode", URL)

End Function


' Gets the keys from Json object
Public Function GetPropertyKeys(ByVal oJson As Object) As Variant

    Const strFUNCTION As String = "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "

    Dim ret As Variant

    If Not oJson Is Nothing Then
        oScript.AddCode strFUNCTION
        ret = Split(oScript.Run("getKeys", oJson), ",")
    End If

    ' Return the value
    GetPropertyKeys = ret

End Function

' Gets a property object from json
Public Function GetObjectProperty(ByVal oJson As Object, _
                                  ByVal strProperty As String) As Object

    Const strFUNCTION As String = "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "

    Dim ret As Object

    If Not oJson Is Nothing Then
        oScript.AddCode strFUNCTION
        If Not IsEmpty(oScript.Run("getProperty", oJson, strProperty)) Then
            Set ret = oScript.Run("getProperty", oJson, strProperty)
        End If
    End If

    ' Return the value
    Set GetObjectProperty = ret

End Function

' Get the value of a property
Public Function GetProperty(ByVal oJson As Object, _
                            ByVal strProperty As String) As Variant

    Const strFUNCTION As String = "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "

    Dim ret As Variant

    If Not oJson Is Nothing Then
        oScript.AddCode strFUNCTION
        ret = oScript.Run("getProperty", oJson, strProperty)
    End If

    ' Return the value
    GetProperty = ret

End Function

This is the early binding version of the code. You can read about late and early binding in this http://www.dicks-clicks.com/excel/olBinding.htm

Also these are the references I am using:

Option Explicit

Dim oScript As New MSScriptControl.ScriptControl
Dim oHttp As New WinHttp.WinHttpRequest

Sub MainRunner()

    Const strAVAILABILITY As String = "https://primenow.amazon.co.uk/fulfillment/availability/"

    Dim ws As Worksheet
    Dim i As Long

    'Initalize variables
    Set ws = ThisWorkbook.Worksheets("Postcodes")
    oScript.Language = "JScript"


    ' Loop through every cell.
    i = 1
    Do While ws.Cells(i, 1).Value <> vbNullString
        ws.Cells(i, 2).Value = GetData(strAVAILABILITY & ws.Cells(i, 1).Value)
        i = i + 1
    Loop

End Sub

' Retrieves the data using an http request
Function GetData(ByVal strUrl As String) As String

    Dim oJson As Object
    Dim oAvailability As Object

    ' Encode the URl in case there are special chars
    strUrl = EncodeURL(strUrl)

    ' Prepare the Http Request
    oHttp.Open "GET", strUrl, False
    oHttp.send

    If oHttp.Status = 200 Then

        ' Get the JSON object returned
        Set oJson = GetJSonObject(oHttp.responseText)

        If Not oJson Is Nothing Then
            Set oAvailability = GetObjectProperty(oJson, "availability")
            If Not oAvailability Is Nothing Then
                ' Return the information in a string
                GetData = ParseAvailabilty(oAvailability)
            End If
        End If
    End If

End Function

' Parse the results into a string.
Function ParseAvailabilty(oAvailabilty As Object) As String

    Dim varFinal() As Variant
    Dim varData As Variant
    Dim i As Long

    varData = GetPropertyKeys(oAvailabilty)
    ReDim varFinal(UBound(varData))

    For i = LBound(varData) To UBound(varData)
        varFinal(i) = varData(i) & ":" & GetProperty(oAvailabilty, varData(i))
    Next i

    'Return the value
    ParseAvailabilty = Join(varFinal, ", ")

End Function

' Gets a json object
Public Function GetJSonObject(ByVal strJson As String) As Object

     Dim ret As Object

    ' We wrap it in an error reseum next incase is could not
    ' be parsed
    On Error Resume Next
    Set ret = oScript.Eval("(" & strJson & ")")
    On Error GoTo 0

    ' Return the value
    Set GetJSonObject = ret

End Function

' Encode URL
Public Function EncodeURL(ByVal URL As String) As Variant

    Const strFUNCTION As String = "function encode(o) { return encodeURI(o);}"

    oScript.AddCode strFUNCTION
    EncodeURL = oScript.Run("encode", URL)

End Function


' Gets the keys from Json object
Public Function GetPropertyKeys(ByVal oJson As Object) As Variant

    Const strFUNCTION As String = "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "

    Dim ret As Variant

    If Not oJson Is Nothing Then
        oScript.AddCode strFUNCTION
        ret = Split(oScript.Run("getKeys", oJson), ",")
    End If

    ' Return the value
    GetPropertyKeys = ret

End Function

' Gets a property object from json
Public Function GetObjectProperty(ByVal oJson As Object, _
                                  ByVal strProperty As String) As Object

    Const strFUNCTION As String = "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "

    Dim ret As Object

    If Not oJson Is Nothing Then
        oScript.AddCode strFUNCTION
        If Not IsEmpty(oScript.Run("getProperty", oJson, strProperty)) Then
            Set ret = oScript.Run("getProperty", oJson, strProperty)
        End If
    End If

    ' Return the value
    Set GetObjectProperty = ret

End Function

' Get the value of a property
Public Function GetProperty(ByVal oJson As Object, _
                            ByVal strProperty As String) As Variant

    Const strFUNCTION As String = "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "

    Dim ret As Variant

    If Not oJson Is Nothing Then
        oScript.AddCode strFUNCTION
        ret = oScript.Run("getProperty", oJson, strProperty)
    End If

    ' Return the value
    GetProperty = ret

End Function

and here there is a slightly faster version of the main procedure. We place the data in an array so excel does does have to work every time data has to be written to the sheet. We write it all at the same tome at the end.

Sub MainRunner()

    Const strAVAILABILITY As String = "https://primenow.amazon.co.uk/fulfillment/availability/"

    Dim ws As Worksheet
    Dim arrData As Variant
    Dim lRow As Long
    Dim i As Long

    'Initalize variables
    Set ws = ThisWorkbook.Worksheets("Postcodes")
    oScript.Language = "JScript"
    lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    arrData = ws.Cells(1, 1).Resize(lRow, 2).Value

    ' Loop through every row in the array.
    For i = 1 To lRow
        arrData(i, 2) = GetData(strAVAILABILITY & arrData(i, 1))
    Next i

    ' Put the data back in the worksheet
    ws.Cells(1, 1).Resize(lRow, 2).Value = arrData


End Sub

No Scrip Used And to our long list of solutions and tried I am adding the solution without the scrip. The scrip is good since it allows us to see the JSON response for what it is a JSON object; but in really its no more than a string so we can get the values from it with a MID function.

Option Explicit

Dim oHttp As New WinHttp.WinHttpRequest

Sub MainRunner()

    Const strAVAILABILITY As String = "https://primenow.amazon.co.uk/fulfillment/availability/"

    Dim ws As Worksheet
    Dim i As Long

    'Initalize variables
    Set ws = ThisWorkbook.Worksheets("Postcodes")

    ' Loop through every cell.
    i = 1
    Do While ws.Cells(i, 1).Value <> vbNullString
        ws.Cells(i, 2).Value = GetData(strAVAILABILITY & ws.Cells(i, 1).Value)
        i = i + 1
    Loop

End Sub

' Retrieves the data using an http request
Function GetData(ByVal strUrl As String) As String

    ' Encode the URl in case there are special chars
    ' preserve the protocol
    strUrl = URLEncode(strUrl)

    ' Prepare the Http Request
    oHttp.Open "GET", strUrl, False
    oHttp.send

    If oHttp.Status = 200 Then

        ' Return the information in a string
        GetData = ParseAvailabilty(oHttp.ResponseText)

    End If

End Function

' Parse the results into a string.
Function ParseAvailabilty(strJson As String) As String

    Const strSTART As String = """availability"":{"
    Const strEND As String = "}"

    Dim lStart As Long
    Dim lEnd As Long

    ' Determine the location of the markers in the string
    lStart = InStr(1, strJson, strSTART)

    If Not lStart = 0 Then

        lStart = lStart + Len(strSTART) + 1
        lEnd = InStr(lStart, strJson, strEND) - 1

        If Not lEnd = 0 Then
            ParseAvailabilty = Mid$(strJson, lStart, lEnd - lStart)
            ParseAvailabilty = Replace$(ParseAvailabilty, """", "")
            ParseAvailabilty = Replace$(ParseAvailabilty, ",", ", ")
        End If
    End If

End Function


' Function to encode URLs
' Used from thie post
' http://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba
Function URLEncode(ByVal Text As String) As String
    Dim i As Integer
    Dim acode As Integer
    Dim char As String

    URLEncode = Text

    For i = Len(URLEncode) To 1 Step -1
        acode = Asc(Mid$(URLEncode, i, 1))
        Select Case acode
            Case 48 To 57, 65 To 90, 97 To 122
                ' don't touch alphanumeric chars
            Case 32
                ' replace space with "%20"
                URLEncode = Left$(URLEncode, i - 1) & "%20" & Mid$(URLEncode, i + 1)
            Case 46, 47, 58
                ' Dont touche ":" or "/"
            Case Else
                ' replace punctuation chars with "%hex"
                URLEncode = Left$(URLEncode, i - 1) & "%" & Hex$(acode) & Mid$(URLEncode, i + 1)
        End Select
    Next

End Function

I hope this helps. :)


Need Your Help

c++ erase the std::vector.end() while looping over all iterators

c++ standard-library

I want to erase some iterator from a vector, so this is what I have now.

Python | efficiency and performance

python optimization premature-optimization

Lets say I'm going to save 100 floating point numbers in a list by running a single script, most probably it will take some memory to process.So if this code executes every time as a requirement of...