Import Data from Flipcart
Sub Web_WebScrapping_Upto_10_Pages()
Dim Wkb As Workbook
Set Wkb = Workbooks.Add
Dim Sh As Worksheet
Set Sh = Wkb.Sheets("Sheet1")
Sh.Range("A1").Value = "Phone Name"
Sh.Range("B1").Value = "Star Rating"
Sh.Range("C1").Value = "Rating & Reviews"
Sh.Range("D1").Value = "Ram & GB"
Sh.Range("E1").Value = "HD & Display"
Sh.Range("F1").Value = "Camera"
Sh.Range("G1").Value = "Battery"
Sh.Range("H1").Value = "Processor"
Sh.Range("I1").Value = "Warranty"
Sh.Range("J1").Value = "Before Discount"
Sh.Range("K1").Value = "Discount"
Sh.Range("L1").Value = "After Discount"
Dim IE As InternetExplorer
Set IE = New InternetExplorer
IE.Visible = True
IE.navigate "https://www.flipkart.com/mobiles/smartphones~type/pr?sid=tyy,4io"
Do While IE.Busy = True Or IE.readyState <> 4
Application.Wait (Now + TimeValue("00.00.01"))
Loop
Dim WebPage As HTMLDocument
Set WebPage = IE.document
Application.Wait (Now + TimeValue("00:00:02"))
Dim NameClass
Set NameClass = WebPage.getElementsByClassName("_3pLy-c row")
Dim PageNumb As Integer
Dim PageClass
StartRow = 2
For PageNumb = 1 To 11
If PageNumb > 1 Then
Set PageClass = WebPage.getElementsByClassName("yFHi8N")
For Each link In PageClass
link.Children(PageNumb).Click
Do While IE.Busy = True Or IE.readyState <> 4
'Application.Wait (Now + TimeValue("00.00.01"))
Loop
Set WebPage = IE.document
Set NameClass = WebPage.getElementsByClassName("_3pLy-c row")
Exit For
Next
End If
For Each E In NameClass
Sh.Cells(StartRow, 1).Activate
Sh.Cells(StartRow, 1).Value = E.getElementsByTagName("Div")(1).innerText
'MsgBox E.getElementsByTagName("Div")(2).innerText
'If Rating missed application considers Div TagNumber as Two else 4
DivTagNumber = 2
RatingMissed = 3
If InStr(E.getElementsByTagName("Div")(2).innerText, "Ratings") > 0 And InStr(E.getElementsByTagName("Div")(2).innerText, "Reviews") > 0 Then
Sh.Cells(StartRow, 2).Value = E.getElementsByTagName("Div")(2).Children(0).innerText
Sh.Cells(StartRow, 3).Value = E.getElementsByTagName("Div")(2).Children(1).innerText
DivTagNumber = 4
RatingMissed = 0
End If
StartCol = 3
For Each q In E.getElementsByTagName("Div")(DivTagNumber).getElementsByTagName("li")
StartCol = StartCol + 1
If StartCol >= 10 Then
Sh.Cells(StartRow, 9).Value = Sh.Cells(StartRow, 9).Value & "||" & q.innerText
Else
Sh.Cells(StartRow, StartCol).Value = q.innerText
End If
Next
Sh.Cells(StartRow, 10).Value = E.getElementsByTagName("Div")(9 - RatingMissed).innerText
Sh.Cells(StartRow, 11).Value = E.getElementsByTagName("Div")(10 - RatingMissed).innerText
If Not E.getElementsByTagName("Div")(8) Is Nothing Then
Sh.Cells(StartRow, 12).Value = E.getElementsByTagName("Div")(8).innerText
End If
StartRow = StartRow + 1
Next
Application.StatusBar = PageNumb
Next
IE.Quit
With Sh.UsedRange
.Font.Size = 15
.Font.Name = "Adobe Garamond Pro Bold"
.HorizontalAlignment = xlLeft
With .Rows(1)
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
.HorizontalAlignment = xlCenter
End With
End With
Sh.UsedRange.Columns.AutoFit
Sh.UsedRange.RowHeight = 21
For c = 1 To Sh.UsedRange.Columns.Count
If Sh.UsedRange.Columns(c).ColumnWidth > 25 Then
Sh.UsedRange.Columns(c).ColumnWidth = 18
End If
If c Mod 2 = 0 Then
Sh.Range(Cells(2, c), Cells(Sh.UsedRange.Rows.Count, c)).Interior.ColorIndex = 15
End If
Next
Application.StatusBar = ""
MsgBox "Process Completed"
Set Wkb = Nothing
Set IE = Nothing
End Sub