-
July 6th, 2015, 12:47 PM
#1
**** Grabbing Macros
Hello! I want to grab the urls from this http://www.****.com/sch/Motorcycles-...cat=6024&rt=nc page and extract the data from the individual tables. I have a macro, ListURls, that works perfectly,
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 = "http://www.****.com/sch/Motorcycles-/6024/i.html?_nkw=&_dcat=6024&rt=nc"
Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A2")
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
but it pastes the links in a format of cgi.****., which doesnt work when i run my GetData macro,
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
' Is this element a text value?
If Elem.NodeType = 3 Then
' Separate text elements with a space character.
ElemText = ElemText & Elem.NodeValue & " "
Else
' Keep parsing - Element contains other non text elements.
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
Set WebPage = CreateObject("InternetExplorer.Application")
With WebPage
WebPage.Navigate URL
WebPage.Visible = False
While .ReadyState <> 4: DoEvents: Wend
If .Status <> 200 Then
GetWebDocument = "Error"
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 = "attrLabels" 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
' Check if Table exists.
If oTable Is Nothing Then
Rng.Offset(0, 1).Value = "Item Specifics were not found on this page."
GoTo NextURL
End If
c = 1
' Read the row data and output it to the worksheet.
For n = 0 To oTable.Rows.Length - 1
Text = ""
Text = GetElemText(oTable.Rows(n), Text)
' To avoid an error, check there is text to output.
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 Sub
I get an error 438 "object doesnt support this method" when I run this macro on the If status <>200 line. I have no idea what is wrong any help is appreciated!!
-
July 8th, 2015, 09:29 AM
#2
Re: **** Grabbing Macros
When talking about Macros you really should state what app you are working with. VBA varies a bit by what product you are using. I assume in this case you are using Excel VBA.
I do not code in Excel at all but it sounds like the object
MSXML2.XMLHTTP does not have a .Status property
Curious though as first you say it works perfectly and then you say you get an error on a given line within the so called perfectly working sub routine.
Always use [code][/code] tags when posting code.
-
July 8th, 2015, 12:21 PM
#3
Re: **** Grabbing Macros
Sorry, I am working in Excel VBA. When I paste links in this format http://www.****.com/itm/Harley-David...m=191623359787, the GetData Macro works, but the ListUrl pastes the links in this format : http://cgi.****.com/****motors/Harle...a46d2b&vxp=mtr. Even though they link to the same page, GetData errors out on these types of links. Sorry about the confusion.
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|