VBA脚本从网站拉数据

我想从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”所以这个代码应该工作：

 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来代替。 可以肯定的是，进入这个QuirksMode页面来确定你的浏览器支持什么。

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

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