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脚本，而且不知道为什么它不是拉动的价值形成类“NowValue”

任何帮助，将不胜感激:)

Answer 1

On Error Resume Next行正在停止显示错误消息。该错误消息是HTMLDocument上没有名为“getElementByClass”的方法。你可能想要“getElementsByClassName”，而不得不处理这个事实，即返回一个集合而不是单个元素。这样的代码可以工作：

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 

然后，您会发现该页面上有多个类为“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 

编辑：如上面的代码完全适用于我，但不能在问题的工作提问者，他们可能会使用不支持getElementsByClassName的旧版Internet Explorer。可能会使用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