# Excel vba - extracting data from webpage using msxml2.xmlhttp



## nkaggarwal1 (Jan 12, 2019)

Hi , The below link helped me to workout a old problem i was facing of copying picture from website to excel.

https://www.mrexcel.com/forum/excel-...namic+url+cell

Need help again.

The Code and modules which was given was very fast , it processed 500 entries in 20-25 seconds . i had another requirement of extracting data from webpage and i tried the below code and it takes around 3-4 seconds for one record , how can i change this to module format USING MSXML2.XMLHTTP

First column of Asin9 array contains my 100 asin's for which i am trying to nextract a particular data from amazon.in site.

Code-
====
Sub Button1_Click()
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
For i = 1 to 100
On Error Resume Next
Dim IE As New InternetExplorer
IE.Visible = False
IE.navigate "https://www.amazon.in/dp/" & Range("Asin9")(i, 1).Value
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = IE.document
Range("Asin9")(i, 13).Value = Doc.getElementById("imgTagWrapperId").innerHTML
Next
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "Refresh Completed in" & SecondsElapsed & " seconds", vbInformation
End Sub


Kindly advise!!

Thanks,

Nishant.


----------



## Domenic (Jan 12, 2019)

I haven't been able to fully test the following code, since I don't have the specific values contained in the first column of your data.  Nevertheless, see if it provides you with the desired result...


```
Option Explicit

Sub Button1_Click()


    Dim xmlReq As Object
    Dim htmlDoc As Object
    Dim htmlElement As Object
    Dim url As String
    Dim i As Long
    
    On Error GoTo errHandler
    
    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
    Set htmlDoc = CreateObject("HTMLFile")
    
    For i = 1 To Range("Asin9").Rows.Count
        If Len(Range("Asin9")(i, 1)) > 0 Then
            url = "https://www.amazon.in/dp/" & Range("Asin9")(i, 1).Value
            With xmlReq
                .Open "GET", url, False
                .send
            End With
            If xmlReq.Status <> 200 Then
                Range("Asin9")(i, 13).Value = "Error " & xmlReq.Status & ":  " & xmlReq.statusText
            Else
                htmlDoc.body.innerHTML = xmlReq.responseText
                Set htmlElement = htmlDoc.getElementById("imgTagWrapperId")
                If htmlElement Is Nothing Then
                    Range("Asin9")(i, 13).Value = "Item not found"
                Else
                    Range("Asin9")(i, 13).Value = htmlElement.innerHTML
                End If
            End If
        End If
    Next i
        
exitHandler:
    Set xmlReq = Nothing
    Set htmlDoc = Nothing
    Exit Sub
    
errHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
    Resume exitHandler


End Sub
```

Hope this helps!


----------



## nkaggarwal1 (Jan 13, 2019)

Hi Domenic , Thanks a lot , This worked fine and the speed has improved from 3-4 seconds to ~2.5 seconds but i could see one issue , when i run this for multiple  entries 5/10/100/500 , the entries in between randomly misses out . so for example it processes around for 300 out of 500 or 70 out of 100 . I understand this can be because of network speed or my system CPU I/O but i get confused when i run the one for images as it never gives any misses. That is also on XMLHTTP

I made few changes in code which you gave to just gather timinings and few other details.

Sample entry - 
B077PW9V3J

Sub Button1_Click()
Dim xmlReq As Object
    Dim htmlDoc As Object
    Dim htmlElement As Object
    Dim htmlElement1 As Object
    Dim url As String
    Dim i As Long
    Application.ScreenUpdating = False
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    Dim rRange As Range
    Dim rCell As Range
    StartTime = Timer
    'On Error GoTo errHandler
    Set ws = Worksheets("Sheet1")

    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
    Set htmlDoc = CreateObject("HTMLFile")

    With ws
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rRange = .Range("A5:A" & LastRow)
    End With

    For Each rCell In rRange
        If Len(rCell) > 0 Then
            url = "https://www.amazon.in/dp/" & rCell.Value
            With xmlReq
                .Open "GET", url, False
                .send
            End With
            If xmlReq.Status <> 200 Then
                rCell.Offset(, 2).Value = "Error " & xmlReq.Status & ":  " & xmlReq.statusText
            Else
                htmlDoc.body.innerHTML = xmlReq.responseText
                Set htmlElement = htmlDoc.getElementById("imgTagWrapperId")
                Set htmlElement1 = htmlDoc.getElementById("productTitle")
                If htmlElement Is Nothing Then
                    rCell.Offset(, 2).Value = "Item not found"
                Else
                    rCell.Offset(, 2).Value = htmlElement.innerHTML
                End If
                If htmlElement1 Is Nothing Then
                    rCell.Offset(, 1).Value = "Item not found"
                Else
                    rCell.Offset(, 1).Value = htmlElement1.innerText
                End If
            End If
        End If
    Next rCell
    Application.ScreenUpdating = True
    SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "Refresh Completed in" & SecondsElapsed & " seconds", vbInformation

exitHandler:
    Set xmlReq = Nothing
    Set htmlDoc = Nothing
    Exit Sub

errHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
    Resume exitHandler

End Sub


----------



## Domenic (Jan 13, 2019)

When you say that "the entries in between randomly misses out" what do you mean exactly?  Do you get "Error 404: Not Found", or maybe "Item not found", or something else?


----------



## nkaggarwal1 (Jan 13, 2019)

Hi Dominic,  it says item not found,  i made the same entry in all 500 rows and it gave data for randomly around 250-300 entries and for other it gave item not found.


----------



## Domenic (Jan 13, 2019)

That means that the page source for the entry does not contain an element whose ID is imgTagWrapperId.  If you manually check the page source for the entry, do you see an element with that ID?


----------



## nkaggarwal1 (Jan 13, 2019)

Hi Domenic,  thanks,  actually that should not be the case as I copied same entry in all 500 fields,  while processing the script it gave item not found for many same entries randomly.  I feel that's the system cpu issues but I never got that while processing the script for getting the images.


----------



## Domenic (Jan 13, 2019)

Can you provide us with a sample entry that returns "Item not found" ?


----------



## nkaggarwal1 (Jan 13, 2019)

Sample entry is B077PW9V3J,  just put the same entry in 500 rows in column A and try the script


----------



## Domenic (Jan 13, 2019)

It's probably because the website contains dynamic content.  So, when a response is received, the content hasn't fully loaded.  Therefore, I would suggest that you stick with using Internet Explorer.


----------



## nkaggarwal1 (Jan 12, 2019)

Hi , The below link helped me to workout a old problem i was facing of copying picture from website to excel.

https://www.mrexcel.com/forum/excel-...namic+url+cell

Need help again.

The Code and modules which was given was very fast , it processed 500 entries in 20-25 seconds . i had another requirement of extracting data from webpage and i tried the below code and it takes around 3-4 seconds for one record , how can i change this to module format USING MSXML2.XMLHTTP

First column of Asin9 array contains my 100 asin's for which i am trying to nextract a particular data from amazon.in site.

Code-
====
Sub Button1_Click()
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
For i = 1 to 100
On Error Resume Next
Dim IE As New InternetExplorer
IE.Visible = False
IE.navigate "https://www.amazon.in/dp/" & Range("Asin9")(i, 1).Value
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = IE.document
Range("Asin9")(i, 13).Value = Doc.getElementById("imgTagWrapperId").innerHTML
Next
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "Refresh Completed in" & SecondsElapsed & " seconds", vbInformation
End Sub


Kindly advise!!

Thanks,

Nishant.


----------



## nkaggarwal1 (Jan 14, 2019)

Hi Domenic , Thanks , will use both as per requirement (accuracy/speed). many Thanks.

Just wanted to know , Can we extract data from a login/password protected webpage using xmlhttp? If yes , i will open a new thread for that.


----------



## Domenic (Jan 14, 2019)

It should be possible, so yes start a new thread and ask your question there.

Cheers!


----------



## nkaggarwal1 (Feb 1, 2019)

Sub Button1_Click()
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
'Application.ScreenUpdating = False
For i = 1 To 14
  On Error Resume Next
  Dim IE As New InternetExplorer
  IE.Visible = True
 'IE.navigate "https://sellercentral.amazon.in/orders-v3/search?page=1&q=" & Range("Asin9")(i, 1).Value & "&qt=asin&date-range=last-1"
 'IE.navigate "https://sellercentral.amazon.in/orders-v3/search?page=1&date-range=1517077800000-1518632999000&q=" & Range("Asin9")(i, 1).Value & "&qt=asin"
  'Do
  'DoEvents
  'Loop Until IE.readyState = READYSTATE_COMPLETE
  'Dim Doc5 As HTMLDocument
  'Set Doc5 = IE.document
  'Application.Wait Now() + TimeValue("00:00:004")
 'Range("Asin9")(i, 2).Value = Doc5.getElementsByClassName("total-orders-heading")(0).innerText
 'Application.ScreenUpdating = True
 'IE.navigate "https://sellercentral.amazon.in/orders-v3/search?page=1&q=" & Range("Asin9")(i, 1).Value & "&qt=asin&date-range=last-1"
  'Do
  'DoEvents
  'Loop Until IE.readyState = READYSTATE_COMPLETE
  'Dim Doc6 As HTMLDocument
  'Set Doc6 = IE.document
  'Application.Wait Now() + TimeValue("00:00:004")
 'Range("Asin9")(i, 4).Value = Doc6.getElementsByClassName("total-orders-heading")(0).innerText
 'Application.ScreenUpdating = True
 IE.navigate "https://sellercentral.amazon.in/orders-v3/search?page=1&date-range=1548613800000-1550168999000&q=" & Range("Asin9")(i, 1).Value & "&qt=asin"
  Do
  DoEvents
  Loop Until IE.readyState = READYSTATE_COMPLETE
  Dim Doc7 As HTMLDocument
  Set Doc7 = IE.document
  Application.Wait Now() + TimeValue("00:00:004")
 Range("Asin9")(i, 6).Value = Doc7.getElementsByClassName("total-orders-heading")(0).innerText
 Application.ScreenUpdating = True
 Next
 'Application.ScreenUpdating = True
 SecondsElapsed = Round(Timer - StartTime, 2)
 MsgBox "Refresh Completed in" & SecondsElapsed & " seconds", vbInformation
End Sub


----------



## B___P (Feb 1, 2019)

Hi nkaggarwal1,
I use this line of code to wait for webpage content fully loaded

```
Do While IE.Busy Or IE.ReadyState <> 4: DoEvents: Loop
```

Give it a try and let us know.
Have a nice weekend


----------

