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