Private Sub CommandButton3_Click()
Dim ie As Object
Dim htmlDoc As Object
Dim nextPageElement As Object
Dim div As Object
Dim link As Object
Dim URL As String
Dim pageNumber As Long
Dim i As Long
Dim class As String
' Takes Url from Sheet1 A2 seach from Keyword from B2 and places IE
URL = Sheets("Sheet1").Range("A2").Value & Replace(Worksheets("Sheet1").Range("B2").Value, " ", "+")
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate URL
Do While .Busy Or .readyState <> 4
DoEvents
Loop
End With
Application.Wait Now + TimeSerial(0, 0, 5)
Set htmlDoc = ie.document
pageNumber = 1
i = 4
Do
'I need to have the ability to extract child elements, so if several elements are using the same class, i need to
'be able to extract the child. I don't think this code does this
'Extracts href to column 1
For Each link In htmlDoc.getElementsByTagName("a")
If link.getAttribute("class") = "vip" Then
Cells(i, 1).Value = link.getAttribute("href")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 1).Value = "Nil"
i = i + 1
End If
'Extracts Title to column 2
If link.getAttribute("class") = "lvtitle" Then
Cells(i, 2).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 2).Value = "Nil"
i = i + 1
End If
'Extracts Amount Of Items Sold to column 3
If link.getAttribute("class") = "hotness-signal red" Then
Cells(i, 3).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 3).Value = "Nil"
i = i + 1
End If
'Extracts Item Price to column 4
If link.getAttribute("class") = "prRange" Then
Cells(i, 4).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 4).Value = "Nil"
i = i + 1
End If
'Extracts SUB Title to column 5
If link.getAttribute("class") = "lvsubtitle" Then
Cells(i, 5).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 5).Value = "Nil"
i = i + 1
End If
'Extracts Items Previous Price to column 6
If link.getAttribute("class") = "stk-thr" Then
Cells(i, 6).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 6).Value = "Nil"
i = i + 1
End If
'Extracts Item Shipping to column 7
If link.getAttribute("class") = "bfsp" Then
Cells(i, 7).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 7).Value = "Nil"
i = i + 1
End If
' ++++++ AUCTION ITEMS +++++++
'Extracts Item Auction price/Or Other price to column 8
If link.getAttribute("class") = "bold" Then
Cells(i, 8).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 8).Value = "Nil"
i = i + 1
End If
'Extracts Auction Bidds to column 9
If link.getAttribute("class") = "lvformat" Then
Cells(i, 9).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 9).Value = "Nil"
i = i + 1
End If
'Extracts Auction Shipping Costs to column 10
If link.getAttribute("class") = "fee" Then
Cells(i, 10).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 10).Value = "Nil"
i = i + 1
End If
'Extracts Auction End Time to column 11
If link.getAttribute("class") = "fee" Then
Cells(i, 11).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 11).Value = "Nil"
i = i + 1
End If
'Extracts Free Postage to column 12
If link.getAttribute("class") = "FnFl fnf-green" Then
Cells(i, 12).Value = link.getAttribute("innertext")
i = i + 1
Else
If link.getAttribute Is Nothing Then
Cells(i, 12).Value = "Nil"
i = i + 1
End If
' All THIS IS NOT WORKING WITH THIS CODE, I DO NEED THIS
' Next link
' ' Clicks and goes to next page
' If pageNumber >= 1 Then Exit Do
' Set nextPageElement = htmlDoc.getElementsByClassName("gspr next")(0)
' If nextPageElement Is Nothing Then Exit Do
'
' nextPageElement.Click 'next web page
' Do While ie.Busy Or ie.readyState <> 4
' DoEvents
' Loop
' Application.Wait Now + TimeSerial(0, 0, 5)
' Set htmlDoc = ie.document
' pageNumber = pageNumber + 1
' Loop
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next
Loop
MsgBox "All Done"
ie.Quit
Set ie = Nothing
Set htmlDoc = Nothing
Set nextPageElement = Nothing
Set div = Nothing
Set link = Nothing
End Sub