VBA 脚本从网站拉取数据

Question

我想从 http://www.buyshedsdirect.co.uk/ 中提取数据以获取特定商品的最新价格。

我有一个 excel 电子表格，其中包含以下内容：

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

和 VBA 脚本：

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

我是 VBA 脚本的新手，不知道为什么它不从 class "NowValue"

中提取值

任何帮助将不胜感激:)

Answer 1

On Error Resume Next 行停止显示错误消息。该错误消息是 HTMLDocument 上没有名为 "getElementByClass" 的方法。您可能需要 "getElementsByClassName" 而必须处理这样一个事实，即此 returns 是一个集合而不是单个元素。这样的代码可以工作：

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

然后您会发现该页面上有多个带有 class "NowValue" 的元素。看起来你想要的可能包含在一个名为 "VariantPrice" 的 div 中，所以这段代码应该有效：

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: 因为上面的代码对我来说很完美，但对提问者不起作用，可能是他们使用的是旧版本的 Internet Explorer不支持 getElementsByClassName。可能使用 querySelector 会起作用。要确定，请转至 this QuirksMode page 以确定您的浏览器支持的确切内容。

使用 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

进一步编辑： 使宏循环遍历 A 列中的所有条目，这里是要添加或更改的相关位：

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

VBA 脚本从网站拉取数据

VBA Script pull data from website

vba

excel

data-extraction