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脚本的新手，并且不知道为什么它不会从类中拉出价值＆＃34; NowValue＆＃34;

任何帮助将不胜感激：）

Answer 1

On Error Resume Next行正在停止显示错误消息。该错误消息将是HTMLDocument上没有名为＆＃34; getElementByClass＆＃34;的方法。你可能想要＆＃34; getElementsByClassName＆＃34;相反，并将必须处理这返回一个集合而不是一个元素的事实。像这样的代码可以工作：

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

然后你会发现有多个元素有类＆＃34; NowValue＆＃34;在那个页面上。看起来好像你想要的那个可能被包含在名为＆＃34; VariantPrice＆＃34;的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

编辑：因为上面的代码对我来说非常有效，但无法为提问者工作，可能是因为他们使用的旧版本的Internet Explorer不支持{{ 1}}。可能会出现使用getElementsByClassName的情况。要确定，请转到this QuirksMode page以确定您的浏览器支持的确切内容。

使用querySelector的新代码：

querySelector

进一步编辑：使宏循环遍历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

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

VBA脚本从网站提取数据

1 个答案: