Hi All,
I am trying to get details of top 100 best sellers book from Amazon and all I am able to get is top 20 using below VBA Code:
-----------------------------------------------------
Sub ImportDatafromAmazon1()
Dim i As Integer
Dim firstRow As Integer
Dim lastRow As Integer
Dim nextRow As Integer
Dim URLstart As String
Dim URLend As String
Dim shStats As Worksheet
Dim shQuery As Worksheet
Dim rgQuery As Range
Dim found As Range
Dim TimeOutWebQuery
Dim TimeOutTime
Dim objIE As Object
Application.ScreenUpdating = False
URLstart = "https://www.amazon.com/Best-Sellers-Books-Business-Money/zgbs/books/3/ref=zg_bs_nav_b_1_b"
Application.DisplayAlerts = False
On Error Resume Next
On Error GoTo 0
Application.DisplayAlerts = True
ActiveSheet.Name = "Amazon B&M - Raw Data"
Set shStats = Sheets("Amazon B&M - Raw Data")
For i = 1 To 2
Sheets("Amazon B&M - Raw Data").Select
Set shQuery = ActiveSheet
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Visible = False
.Navigate CStr(URLstart & i & URLend)
End With
TimeOutWebQuery = 10
TimeOutTime = DateAdd("s", TimeOutWebQuery, Now)
Do Until objIE.ReadyState = 4
DoEvents
If Now > TimeOutTime Then
objIE.stop
GoTo ErrorTimeOut
End If
Loop
objIE.ExecWB 17, 2
objIE.ExecWB 12, 2
shQuery.Range("A1").Select
shQuery.PasteSpecial NoHTMLFormatting:=True
objIE.Quit
Set objIE = Nothing
Set found = shQuery.Columns(1).Find("Player", , , xlWhole)
If Not found Is Nothing Then
firstRow = found.Row
If i > 1 Then firstRow = firstRow + 1
Else
GoTo FormatError
End If
Set found = shQuery.Columns(1).Find("Page ", found, , xlPart)
If Not found Is Nothing Then
lastRow = found.Row - 1
Else
GoTo FormatError
End If
Set rgQuery = shQuery.Rows(firstRow & ":" & lastRow)
nextRow = shStats.Cells(Rows.Count, "A").End(xlUp).Row
If nextRow > 1 Then nextRow = nextRow + 1
rgQuery.Copy shStats.Cells(nextRow, 1)
Application.DisplayAlerts = False
shQuery.Delete
Application.DisplayAlerts = True
Next i
shStats.Columns.AutoFit
MsgBox "Query complete"
Exit Sub
FormatError:
ImportDatafromAmazon2
Exit Sub
ErrorTimeOut:
objIE.Quit
Set objIE = Nothing
MsgBox "WebSite Error"
End Sub
--------------------------------------------------------
I have also tried to use RSS feed but results are similar. I would highly appreciate if you can please advice me how can I import this data in excel using VBA.
Best Regards,
Sachin
I am trying to get details of top 100 best sellers book from Amazon and all I am able to get is top 20 using below VBA Code:
-----------------------------------------------------
Sub ImportDatafromAmazon1()
Dim i As Integer
Dim firstRow As Integer
Dim lastRow As Integer
Dim nextRow As Integer
Dim URLstart As String
Dim URLend As String
Dim shStats As Worksheet
Dim shQuery As Worksheet
Dim rgQuery As Range
Dim found As Range
Dim TimeOutWebQuery
Dim TimeOutTime
Dim objIE As Object
Application.ScreenUpdating = False
URLstart = "https://www.amazon.com/Best-Sellers-Books-Business-Money/zgbs/books/3/ref=zg_bs_nav_b_1_b"
Application.DisplayAlerts = False
On Error Resume Next
On Error GoTo 0
Application.DisplayAlerts = True
ActiveSheet.Name = "Amazon B&M - Raw Data"
Set shStats = Sheets("Amazon B&M - Raw Data")
For i = 1 To 2
Sheets("Amazon B&M - Raw Data").Select
Set shQuery = ActiveSheet
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Visible = False
.Navigate CStr(URLstart & i & URLend)
End With
TimeOutWebQuery = 10
TimeOutTime = DateAdd("s", TimeOutWebQuery, Now)
Do Until objIE.ReadyState = 4
DoEvents
If Now > TimeOutTime Then
objIE.stop
GoTo ErrorTimeOut
End If
Loop
objIE.ExecWB 17, 2
objIE.ExecWB 12, 2
shQuery.Range("A1").Select
shQuery.PasteSpecial NoHTMLFormatting:=True
objIE.Quit
Set objIE = Nothing
Set found = shQuery.Columns(1).Find("Player", , , xlWhole)
If Not found Is Nothing Then
firstRow = found.Row
If i > 1 Then firstRow = firstRow + 1
Else
GoTo FormatError
End If
Set found = shQuery.Columns(1).Find("Page ", found, , xlPart)
If Not found Is Nothing Then
lastRow = found.Row - 1
Else
GoTo FormatError
End If
Set rgQuery = shQuery.Rows(firstRow & ":" & lastRow)
nextRow = shStats.Cells(Rows.Count, "A").End(xlUp).Row
If nextRow > 1 Then nextRow = nextRow + 1
rgQuery.Copy shStats.Cells(nextRow, 1)
Application.DisplayAlerts = False
shQuery.Delete
Application.DisplayAlerts = True
Next i
shStats.Columns.AutoFit
MsgBox "Query complete"
Exit Sub
FormatError:
ImportDatafromAmazon2
Exit Sub
ErrorTimeOut:
objIE.Quit
Set objIE = Nothing
MsgBox "WebSite Error"
End Sub
--------------------------------------------------------
I have also tried to use RSS feed but results are similar. I would highly appreciate if you can please advice me how can I import this data in excel using VBA.
Best Regards,
Sachin