VBA脚本从网站提取数据 [英] VBA Script pull data from website

问题描述

我想从 http://www.buyshedsdirect.co.uk/ 中提取数据获取最新的具体项目的价格。

我有一个excel电子表格，具有以下内容：

  | A | B 
 1 |项目|价格
 2 | bfd /花园结构/拱门/总理拱廊
  

和VBA脚本：

  Dim ie As New InternetExplorer 
 Dim item As String 
 item = Sheet1.Range（A2）。值
 Dim doc作为HTMLDocument 
 
 ie.Visible = True 
 ie.navigatehttp：// www .buyshedsdirect.co.uk /&项目
 
 Do 
 DoEvents 
循环直到ie.readyState = READYSTATE_COMPLETE 
 
设置doc = ie.document 
错误恢复下一步
 output = doc.getElementByClass（NowValue）。innerText 
 Sheet1.Range（B2）。Value = output 
 
 ie.Quit 
 
结束Sub 
  

我是VBA脚本的新手，不知道为什么它不会将类的值任何帮助将不胜感激：）

解决方案

On Error Resume Next line正在停止显示错误消息。那个错误信息是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.navigatehttp://www.buyshedsdirect.co.uk/&项目
 
 Do 
 DoEvents 
循环直到ie.readyState = READYSTATE_COMPLETE 
 
设置doc = ie.document 
 
 Dim结果作为IHTMLElementCollection 
 Dim result As IHTMLElement 
 Dim output As String 
 
设置结果= doc.getElementsByClassName（NowValue）
 output =
 For每个结果在结果中
 output = output& result.innerText 
下一个结果
 
 Sheet1.Range（B2）。Value = output 
 
 ie.Quit 
 
 End Sub 
  

然后您会发现该页面上有NowValue类的多个元素。看起来好像你想要的那个可能被包含在一个名为VariantPrice的div中，所以这个代码应该可以工作：

  Option Explicit 
 
子栏（）
 
 Dim ie As New InternetExplorer 
 Dim item As String 
 item = Sheet1.Range（A2）。 b $ b Dim doc作为HTMLDocument 
 
 ie.Visible = True 
 ie.navigatehttp://www.buyshedsdirect.co.uk/&项目
 
 Do 
 DoEvents 
循环直到ie.readyState = READYSTATE_COMPLETE 
 
设置doc = ie.document 
 
 Dim结果作为IHTMLElementCollection 
 Dim results2 As IHTMLElementCollection 
 Dim result As IHTMLElement 
 Dim result2 As IHTMLElement 
 Dim output As String 
 
设置结果= doc.getElementsByClassName（ VariantPrice）
 output =
对于每个结果在结果中
设置results2 = result.getElementsByClassName（NowValue）
对于每个result2在results2 
 output =输出& result2.innerText 
下一个结果2 
下一个结果
 
 Sheet1.Range（B2）。Value = output 
 
 ie.Quit 
 
 End Sub 
  

编辑：对我而言，无法为问题提问者工作，可能情况下他们使用的旧版本的Internet Explorer不支持 getElementsByClassName 。可能会使用 querySelector 来代替。要确定，请转到此QuirksMode页面，以确定您的浏览器支持的内容。 p>

使用 querySelector 的新代码：

 code> Option Explicit 
 
子栏（）
 
 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）。值
 
 ie.Visible = True 
 ie.navigatehttp://www.buyshedsdirect.co.uk/&项目
 
 Do 
 DoEvents 
循环直到ie.readyState = READYSTATE_COMPLETE 
 
设置doc = ie.document 
 
设置结果= doc.querySelector（。VariantPrice）
设置result2 = result.querySelector（。NowValue）
 
 Sheet1.Range（B2）。Value = result2.innerText 
 
 ie.Quit 
 
 End Sub 
  

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

  Option Explicit 
 
子栏（）
 
 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.navigatehttp://www.buyshedsdirect.co.uk/&项目
 
 Do 
 DoEvents 
循环直到ie.readyState = READYSTATE_COMPLETE 
 
设置doc = ie.document 
 
设置结果= doc.querySelector（。VariantPrice）
设置result2 = result.querySelector（。NowValue）
 
 Sheet1.Range（B& lRow）.Value = result2。 innerText 
 
 lRow = lRow + 1 
 item = Sheet1.Range（A& lRow）.Value 
循环
 
 ie.Quit 
 
 End Sub 
  

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 :)

解决方案

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

这篇关于VBA脚本从网站提取数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！