Hello,
I have 2 macros, one that grabs the links for items on this page (Motorcycles in Model:CB | eBay), called ListUrl
and another called GetData that scrapes the wanted data
The ListUrl function pastes the link into A column like this: Honda CB | eBay, and for some reason I can't figure out GetData errors out when dealing with that link, but works fine with the same link but titled differently Honda CB | eBay. What am I doing wrong and how can I fix this error?
Thanks!
I have 2 macros, one that grabs the links for items on this page (Motorcycles in Model:CB | eBay), called ListUrl
Code:
Sub ListURLs()
Dim Anchors As Object
Dim HTMLdoc As Object
Dim Rng As Range
Dim row As Long
Dim URL As Variant
Dim Wks As Worksheet
URL = ""
Dim Anchors As Object
Dim HTMLdoc As Object
Dim Rng As Range
Dim row As Long
Dim URL As Variant
Dim Wks As Worksheet
URL = "http://www.ebay.com/sch/iPads-Tablets-eBook-Readers-/171485/i.html"
Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A1")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
While .readystate <> 4: DoEvents: Wend
If .Status <> 200 Then
MsgBox "Server Error: " & .Status & " - " & .statusText
Exit Sub
End If
Set HTMLdoc = CreateObject("htmlfile")
HTMLdoc.Write .responseText
HTMLdoc.Close
Set Anchors = HTMLdoc.getElementsByTagName("A")
For Each URL In Anchors
If URL.className = "vip" Then
Rng.Offset(row, 0).Value = URL.href
row = row + 1
End If
Next URL
End With
Set HTMLdoc = Nothing
End Sub
Dim Anchors As Object
Dim HTMLdoc As Object
Dim Rng As Range
Dim row As Long
Dim URL As Variant
Dim Wks As Worksheet
URL = "http://www.ebay.com/sch/iPads-Tablets-eBook-Readers-/171485/i.html"
Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A1")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
While .readystate <> 4: DoEvents: Wend
If .Status <> 200 Then
MsgBox "Server Error: " & .Status & " - " & .statusText
Exit Sub
End If
Set HTMLdoc = CreateObject("htmlfile")
HTMLdoc.Write .responseText
HTMLdoc.Close
Set Anchors = HTMLdoc.getElementsByTagName("A")
For Each URL In Anchors
If URL.className = "vip" Then
Rng.Offset(row, 0).Value = URL.href
row = row + 1
End If
Next URL
End With
Set HTMLdoc = Nothing
End Sub
Dim Anchors As Object
Dim HTMLdoc As Object
Dim Rng As Range
Dim row As Long
Dim URL As Variant
Dim Wks As Worksheet
URL = "http://www.ebay.com/sch/iPads-Tablets-eBook-Readers-/171485/i.html"
Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A1")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
While .readystate <> 4: DoEvents: Wend
If .Status <> 200 Then
MsgBox "Server Error: " & .Status & " - " & .statusText
Exit Sub
End If
Set HTMLdoc = CreateObject("htmlfile")
HTMLdoc.Write .responseText
HTMLdoc.Close
Set Anchors = HTMLdoc.getElementsByTagName("A")
For Each URL In Anchors
If URL.className = "vip" Then
Rng.Offset(row, 0).Value = URL.href
row = row + 1
End If
Next URL
End With
Set HTMLdoc = Nothing
End Sub
Dim Anchors As Object
Dim HTMLdoc As Object
Dim Rng As Range
Dim row As Long
Dim URL As Variant
Dim Wks As Worksheet
URL = "www.ebay.com/sch/Motorcycles-/6024/i.html?_nkw=&_dcat=6024&Model=CB&rt=nc"
Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A1")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
While .readystate <> 4: DoEvents: Wend
If .Status <> 200 Then
MsgBox "Server Error: " & .Status & " - " & .statusText
Exit Sub
End If
Set HTMLdoc = CreateObject("htmlfile")
HTMLdoc.Write .responseText
HTMLdoc.Close
Set Anchors = HTMLdoc.getElementsByTagName("A")
For Each URL In Anchors
If URL.className = "vip" Then
Rng.Offset(row, 0).Value = URL.href
row = row + 1
End If
Next URL
End With
Set HTMLdoc = Nothing
End Sub
Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A1")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
While .readystate <> 4: DoEvents: Wend
If .Status <> 200 Then
MsgBox "Server Error: " & .Status & " - " & .statusText
Exit Sub
End If
Set HTMLdoc = CreateObject("htmlfile")
HTMLdoc.Write .responseText
HTMLdoc.Close
Set Anchors = HTMLdoc.getElementsByTagName("A")
For Each URL In Anchors
If URL.className = "vip" Then
Rng.Offset(row, 0).Value = URL.href
row = row + 1
End If
Next URL
End With
Set HTMLdoc = Nothing
End Sub
Code:
Global HTMLdoc As Object
Function GetElemText(ByRef Elem As Object, Optional ByRef ElemText As String) As String
If Elem Is Nothing Then ElemText = "~": Exit Function
If Elem.NodeType = 3 Then
ElemText = ElemText & Elem.NodeValue & " "
Else
For Each Elem In Elem.ChildNodes
Select Case UCase(Elem.NodeName)
Case Is = "BR": ElemText = vbLf
Case Is = "TD": If ElemText <> "" Then ElemText = ElemText & "|"
Case Is = "TR": ElemText = ElemText & vbLf
End Select
Call GetElemText(Elem, ElemText)
Next Elem
End If
GetElemText = ElemText
End Function
Function GetWebDocument(ByVal URL As String) As Variant
Dim Text As String
Set HTMLdoc = Nothing
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, True
.Send
While .readystate <> 4: DoEvents: Wend
If .Status <> 200 Then
GetWebDocument = "ERROR: " & .Status & " - " & .StatusResponse
Exit Function
End If
Text = .responseText
End With
Set HTMLdoc = CreateObject("htmlfile")
HTMLdoc.Write Text
HTMLdoc.Close
End Function
Sub GetData()
Dim Data As Variant
Dim n As Long
Dim oDiv As Object
Dim oTable As Object
Dim ret As Variant
Dim Rng As Range
Dim Text As String
Set Rng = Range("A2")
Do While Not IsEmpty(Rng)
ret = GetWebDocument(Rng)
' Check for a web page error.
If Not IsEmpty(ret) Then
Rng.Offset(0, 1).Value = ret
GoTo NextURL
End If
Set oDiv = HTMLdoc.getElementByID("vi-desc-maincntr")
' Locate the Item Specifics Table.
For n = 0 To oDiv.Children.Length - 1
If oDiv.Children(n).NodeType = 1 Then
If oDiv.Children(n).className = "itemAttr" Then
On Error Resume Next
Set oDiv = oDiv.Children(n)
Set oDiv = oDiv.Children(0)
Set oTable = oDiv.Children(2)
On Error GoTo 0
Exit For
End If
End If
Next n
If oTable Is Nothing Then
Rng.Offset(0, 1).Value = "Item Specifics were not found on this page."
GoTo NextURL
End If
c = 1
For n = 0 To oTable.Rows.Length - 1
Text = ""
Text = GetElemText(oTable.Rows(n), Text)
If Text <> "" Then
Data = Split(Text, "|")
Rng.Offset(0, c).Resize(1, UBound(Data) + 1).Value = Data
c = c + UBound(Data) + 1
End If
Next n
NextURL:
Set Rng = Rng.Offset(1, 0)
Loop
End SubThanks!
