How to extract a specific data from a website using macros or vba

[pari9485]

I have to note down the no. of reviews from a website page and paste it into excel, Eg: http://www.junglee.com/dp/B00D8WDF22 have 15 reviews on the page and I have to look in the website and write the no of reviews one by one. If the page does not have review then I leave it blank.

Can anyone help me to automate this? It will be very helpful as I have to do this for 1000 products daily


I have attached my excel sheet.

[Leith Ross]

Hello pari9485,

The following macros have been added to the attached workbook. There are in Module1 of the VBA project. A button has been added to the sheet to run the macro.

Module1 Macros

Function GetReviewsCount(ByVal URL As String) As Variant
      
    Dim htmlDoc     As Object
    Dim htmlSpan    As Object
    Dim PageSrc     As String
    
        PageSrc = ""
        
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", URL, True
            .Send
                                
            While .readyState <> 4: DoEvents: Wend
                            
          ' Check for any connection errors. Put the error info in cells A4:B4.
            If .statusText <> "OK" Then
                MsgBox "ERROR" & .Status & " - " & .statusText, vbExclamation
                Exit Function
            End If
                            
            PageSrc = .ResponseText
        End With

      ' Create an empty HTML Document and load it with the PageSource.
        Set htmlDoc = CreateObject("htmlfile")
        htmlDoc.Open URL:="text/html", Replace:=False
            
      ' NOTE: This will check if cookies are enabled and prompt you if they aren't.
        htmlDoc.write PageSrc
        
            For Each htmlSpan In htmlDoc.getElementsByTagName("span")
                If htmlSpan.ClassName = "partner-reviews-count" Then
                    If htmlSpan.NodeType = 1 Then
                        GetReviewsCount = Val(htmlSpan.innerHTML)
                        Exit Function
                    End If
                End If
            Next htmlSpan

        GetReviewsCount = "No Review"
        
End Function

Sub Macro1()

    Dim Cell    As Range
    Dim EndRow  As Long
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        Set Wks = ActiveSheet
        Set Rng = Wks.Range("A2")
        
            EndRow = Wks.Cells(Rows.Count, "A").End(xlUp).Row
            If EndRow < Rng.Row Then Exit Sub Else Set Rng = Rng.Resize(EndRow - Rng.Row + 1, 1)
            
            For Each Cell In Rng
                Cell.Offset(0, 1) = GetReviewsCount(Cell)
            Next Cell
        
End Sub

[pari9485]

Thanks a lot, You are really a genius . It is working and is extremely helpful. Just one thing , while the macro runs , internet explorer pages starts opening, How Can I stop it to open?

[Leith Ross]

Hello pari9485,

After many hours of reading and testing, I have no idea why this is happening. I have saved the page source as a file and edited it several times thinking it could be something in the HTML or JavaScript code. Each edit failed to prevent the Internet Explorer popup. I am running Internet Explorer 10 and according to everything I have read this message should not occur. This was a problem in IE 7 and Microsoft fixed starting with version 8.

I can use this method method to open many other sites with no problem. My best guess is the problem is somehow server related. At this time, I have no workaround to the problem. Perhaps another member has one to offer.

[pari9485]

Its OK . Thanks a lot.