VBA Script pull data from website

问题

I want to pull the data from http://www.buyshedsdirect.co.uk/ to get the most recent prices of specific items.

I have an excel spreadsheet with the following:

|A | B
1 |Item |Price
2 |bfd/garden-structures/arches/premier-arches-pergola

and the VBA script:

Dim ie As New InternetExplorer
Dim item As String
item = Sheet1.Range("A2").Value
Dim doc As HTMLDocument

ie.Visible = True
ie.navigate "http://www.buyshedsdirect.co.uk/" & item

Do
    DoEvents
    Loop Until ie.readyState = READYSTATE_COMPLETE

Set doc = ie.document
On Error Resume Next
output = doc.getElementByClass("NowValue").innerText
Sheet1.Range("B2").Value = output

ie.Quit

End Sub

i am new to VBA scripting and have no idea why it isnt pulling the value form the class "NowValue"

Any help would be appreciated :)

回答1:

The On Error Resume Next line is stopping an error message from being displayed. That error message would be that there is no method on HTMLDocument called "getElementByClass". You probably want "getElementsByClassName" instead and will have to handle the fact that this returns a collection rather than a single element. Code like this would work:

Option Explicit

Sub foo()

Dim ie As New InternetExplorer
Dim item As String
item = Sheet1.Range("A2").Value
Dim doc As HTMLDocument

ie.Visible = True
ie.navigate "http://www.buyshedsdirect.co.uk/" & item

Do
    DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE

Set doc = ie.document

Dim results As IHTMLElementCollection
Dim result As IHTMLElement
Dim output As String

Set results = doc.getElementsByClassName("NowValue")
output = ""
For Each result In results
    output = output & result.innerText
Next result

Sheet1.Range("B2").Value = output

ie.Quit

End Sub

You would then find that there are multiple elements with class "NowValue" on that page. It looks as though the one you want might be enclosed in a div called "VariantPrice" so this code should work:

Option Explicit

Sub bar()

Dim ie As New InternetExplorer
Dim item As String
item = Sheet1.Range("A2").Value
Dim doc As HTMLDocument

ie.Visible = True
ie.navigate "http://www.buyshedsdirect.co.uk/" & item

Do
    DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE

Set doc = ie.document

Dim results As IHTMLElementCollection
Dim results2 As IHTMLElementCollection
Dim result As IHTMLElement
Dim result2 As IHTMLElement
Dim output As String

Set results = doc.getElementsByClassName("VariantPrice")
output = ""
For Each result In results
    Set results2 = result.getElementsByClassName("NowValue")
    For Each result2 In results2
        output = output & result2.innerText
    Next result2
Next result

Sheet1.Range("B2").Value = output

ie.Quit

End Sub

edit: as the code above works perfectly for me but fails to work for the question asker, it may be the case that they are using an older version of Internet Explorer which does not support getElementsByClassName. It may be the case that using querySelector will work instead. To be certain, go to this QuirksMode page to determine exactly what your browser supports.

New code using querySelector:

Option Explicit

Sub bar()

Dim ie As New InternetExplorer
Dim doc As HTMLDocument
Dim result As IHTMLElement
Dim result2 As IHTMLElement
Dim item As String

item = Sheet1.Range("A2").Value

ie.Visible = True
ie.navigate "http://www.buyshedsdirect.co.uk/" & item

Do
    DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE

Set doc = ie.document

Set result = doc.querySelector(".VariantPrice")
Set result2 = result.querySelector(".NowValue")

Sheet1.Range("B2").Value = result2.innerText

ie.Quit

End Sub

further edit: to make the macro loop through all of the entries in column A, here are the relevant bits to add or change:

Option Explicit

Sub bar()

Dim ie As New InternetExplorer
Dim doc As HTMLDocument
Dim result As IHTMLElement
Dim result2 As IHTMLElement
Dim item As String
Dim lRow As Long

ie.Visible = True
lRow = 2
item = Sheet1.Range("A" & lRow).Value

Do Until item = ""
    ie.navigate "http://www.buyshedsdirect.co.uk/" & item

    Do
        DoEvents
    Loop Until ie.readyState = READYSTATE_COMPLETE

    Set doc = ie.document

    Set result = doc.querySelector(".VariantPrice")
    Set result2 = result.querySelector(".NowValue")

    Sheet1.Range("B" & lRow).Value = result2.innerText

    lRow = lRow + 1
    item = Sheet1.Range("A" & lRow).Value   
Loop

ie.Quit

End Sub

来源：https://stackoverflow.com/questions/30943791/vba-script-pull-data-from-website