Sunday, February 14, 2021

Get prices of the products from amazon and flipkart automatically using VBA

 Option Explicit

Sub Search()


Dim sh As Worksheet
Set sh = ActiveSheet

sh.Range("A1").Value = 1

Call Fetch_from_Amazon
    Application.Wait Now + TimeValue("0:00:10")
Call Fetch_from_Flipkart

MsgBox "Done"

End Sub

Sub Fetch_from_Amazon()
 
Dim sh As Worksheet
Set sh = ActiveSheet


Dim i As Integer

Dim IE As InternetExplorer
Dim html_doc As HTMLDocument

Set IE = New InternetExplorer

IE.Visible = True
IE.navigate "WWW.Amazon.in"
Application.Wait (Now + TimeValue("0:00:10"))

'Do Until IE.readyState = READYSTATE_COMPLETE
'    DoEvents
'Loop

''Do Until IE.readyState = 4
''        DoEvents
''    Loop
''
''    Application.Wait (Now + TimeValue("0:00:10"))
''
''    Do Until IE.readyState = 4
''        DoEvents
''    Loop
'
''Set the max time to load
'
'Dim maxLoadingTime As Single, myTimer As Single
'maxLoadingTime = 10     '< -- # of seconds to allow page to load -- <
'myTimer = Timer
'
'Do
'    DoEvents
'    If Timer >= maxLoadingTime + myTimer Then
'        Debug.Print Time & " Notice: Connection Error. Refreshing webpage"
'        IE.stop
'        IE.Refresh
'    End If
'Loop Until IE.readyState = 4


Set html_doc = IE.document

For i = 4 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
    DoEvents
    
    If sh.Range("A1").Value = 0 Then Exit Sub
    
    On Error Resume Next
    
    html_doc.getElementById("twotabsearchtextbox").Value = sh.Range("A" & i).Value
    html_doc.getElementsByClassName("nav-input")(1).Click
    
    Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    
    Application.Wait Now + TimeValue("0:00:02")
    
    sh.Range("B" & i).Value = html_doc.getElementsByClassName("a-size-medium a-color-base a-text-normal")(0).innerText
    sh.Range("C" & i).Value = html_doc.getElementsByClassName("a-price-whole")(0).innerText
     
Next i

IE.Quit


End Sub

Sub Fetch_from_Flipkart()

Dim sh As Worksheet
Set sh = ActiveSheet

Dim IE As InternetExplorer
Dim html_doc As HTMLDocument
Dim i As Integer

Set IE = New InternetExplorer

IE.Visible = True
IE.navigate "WWW.Flipkart.com"


Do Until IE.readyState = READYSTATE_COMPLETE
    DoEvents
Loop

'SendKeys "{ESC}"
'DoEvents

Set html_doc = IE.document

For i = 4 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row

    If sh.Range("A1").Value = 0 Then Exit Sub
    
    DoEvents
    On Error Resume Next
    Dim searchtext As String
    
    html_doc.getElementsByClassName("_3704LK")(0).Value = sh.Range("A" & i).Value
    searchtext = sh.Range("A" & i).Value
    'html_doc.getElementsByClassName("L0Z3Pu")(0).Click
    'ie.navigate "http://www.bestbuy.com/site/searchpage.jsp?st=" & searchtext & "&_dyncharset=UTF-8&id=pcat17071&type=page&sc=Global&cp=1&nrp=&sp=&qp=&list=n&iht=y&usc=All+Categories&ks=960&keys=keys"
    IE.navigate "https://www.flipkart.com/search?q=" & searchtext & "&otracker=search&otracker1=search&marketplace=FLIPKART&as-show=on&as=off&as-pos=1&as-type=HISTORY"
    Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    
    Application.Wait Now + TimeValue("0:00:03")
    
    sh.Range("D" & i).Value = html_doc.getElementsByClassName("_4rR01T")(0).innerHTML
    sh.Range("E" & i).Value = html_doc.getElementsByClassName("_30jeq3 _1_WHN1")(0).innerHTML

Next i

IE.Quit

End Sub



Sub Clear_Sheet()

Dim sh As Worksheet
Set sh = ActiveSheet

sh.Range("B4:E" & Application.Rows.Count).ClearContents

End Sub


Sub Stop_Macro()

Dim sh As Worksheet
Set sh = ActiveSheet

sh.Range("A1").Value = 0

End Sub


I changed some code to make it work,however originally it was in this video


https://youtu.be/0JHbb5-elMU