尝试在 Excel 中使用 VBA 从网页中提取一个值

Question

我这几天一直在寻找信息，但是我找到的所有示例都只有一小部分代码，我需要它=）

我想要做的是从主页中提取一个值并将其放入 Excel 中的单元格中 （然后从同一站点上的另一个页面获取另一个值并放入下一个单元格等）

该页面是瑞典证券交易所页面，我用作测试页面的页面是“投资者 B”(https://www.avanza.se/aktier/om-aktien.html/5247/investor-b) 的股票

我感兴趣的值是名为“Senaste”的值（这是围绕它的页面信息）

<li>
    <span class="XSText">Senast<br/></span>
    <span class="lastPrice SText bold"><span class="pushBox roundCorners3"    title="Senast uppdaterad: 17:29:59">248,60</span></span>
</li>

这是我追求的价值 248,60！

我获得了一些编码经验，但不是 VBA 脚本，在阅读了一些论坛帖子（主要是这里）之后，我自己尝试了一些示例，但无法工作。 由于我对 VBA 很基础，我可能结构错误，所以请对我保持基本和耐心，这是我的测试，但我得到“运行时错误 429” ActiveX 组件无法创建对象

我可能完全走错了路

Private Sub CommandButton1_Click()
Dim ie As Variant
Set ie = CreateObject("InternetExplorer")
ie.navigate "https://www.avanza.se/aktier/om-aktien.html/5247/investor-b"
ie.Visible = True
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Application.Wait (Now() + TimeValue("00:00:016")) ' For internal page refresh or loading
Dim doc As Variant 'variable for document or data which need to be extracted out of webpage
Set doc = CreateObject("HTMLDocument")
Set doc = ie.document
Dim dd As Variant
dd = doc.getElementsByClassName("lastPrice SText bold")(0).innerText
MsgBox dd
End Sub

编辑：2014-05-12 17:05 测试当前代码

按钮命令下

Private Sub CommandButton1_Click()
Dim IE As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")

' You can uncoment Next line To see form results
IE.Visible = False

' Send the form data To URL As POST binary request
IE.Navigate "https://www.avanza.se/aktier/om-aktien.html/5247/investor-b"

' Statusbar
Application.StatusBar = "Loading, Please wait..."

' Wait while IE loading...
'Do While IE.Busy
'    Application.Wait DateAdd("s", 1, Now)
'Loop
'this should go from ready-busy-ready
IEWait IE

Application.StatusBar = "Searching for value. Please wait..."
' Dim Document As HTMLDocument
' Set Document = IE.Document
Dim dd As Variant
dd = IE.Document.getElementsByClassName("lastPrice SText bold")(0).innerText

MsgBox dd

' Show IE
IE.Visible = True

' Clean up
Set IE = Nothing
Set objElement = Nothing
Set objCollection = Nothing

Application.StatusBar = ""


End Sub

在模块1中

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function IEWait(p_ieExp As InternetExplorer)

'this should go from ready-busy-ready
Dim initialReadyState As Integer
initialReadyState = p_ieExp.ReadyState

'wait 250 ms until it's done
Do While p_ieExp.Busy Or p_ieExp.ReadyState <> READYSTATE_COMPLETE
    Sleep 250
Loop

End Function

如前所述，我不知道我的最新插件结构是否正确，恐怕在这种编码中不会过期。

最好的问候

停止编辑 2014-05-12 17:08

Answer 1

您很接近，但有几个小错误。

这是我的设置方式（已测试）：

Private Sub CommandButton1_Click()
    Dim IE As Object

    ' Create InternetExplorer Object
    Set IE = CreateObject("InternetExplorer.Application")

    ' You can uncoment Next line To see form results
    IE.Visible = False

    ' URL to get data from
    IE.Navigate "https://www.avanza.se/aktier/om-aktien.html/5247/investor-b"

    ' Statusbar
    Application.StatusBar = "Loading, Please wait..."

    ' Wait while IE loading...
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Application.StatusBar = "Searching for value. Please wait..."

    Dim dd As String
    dd = IE.Document.getElementsByClassName("lastPrice SText bold")(0).innerText

    MsgBox dd

    ' Show IE
    IE.Visible = True

    ' Clean up
    Set IE = Nothing

    Application.StatusBar = ""
End Sub

---

结果：

---

在 Excel 2010 中使用以下参考进行测试：

---

编辑 - 选项 B

要消除可能的“运行时错误 '91'”，请尝试更改如下几行：

Dim dd As Variant
Set dd = IE.Document.getElementsByClassName("lastPrice SText bold")

MsgBox dd(0).textContent

---

编辑 - 选项 C

另一种获取元素的方法：

Dim tag
Dim tags As Object
Set tags = IE.Document.getElementsByTagName("*")

For Each tag In tags
    If tag.className = "lastPrice SText bold" Then
        MsgBox tag.innerText
        Exit For
    End If
Next tag

（这三种方法均已在 Excel 2010 和 IE10 上测试过）

Answer 2

我只是想添加我目前正在运行的代码，如果人们遇到同样的问题，它目前运行良好。这是为了将两个值放入专用单元格中。

Private Sub CommandButton10_Click()
Dim IE As Object
    Dim dd As Variant
    ' Create InternetExplorer Object
    Set IE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
    IE.Visible = False

    ' Send the form data To URL As POST binary request
    IE.Navigate "https://www.avanza.se/aktier/om-aktien.html/52476/alk-abell-b"

    Application.StatusBar = "Loading, Please wait..."
    IEWait IE

    Application.StatusBar = "Searching for value. Please wait..."
    dd = IE.Document.getElementsByClassName("lastPrice SText bold")(0).innerText

    Range("Y2").Value = dd
    
    IE.Navigate "https://www.avanza.se/aktier/om-aktien.html/52380/alm--brand"

    Application.StatusBar = "Loading, Please wait..."
    IEWait IE

    Application.StatusBar = "Searching for value. Please wait..."
    dd = IE.Document.getElementsByClassName("lastPrice SText bold")(0).innerText

    Range("Y3").Value = dd

' Clean up
    Set IE = Nothing
    Set objElement = Nothing
    Set objCollection = Nothing

    Application.StatusBar = ""
End Sub

如果想要更多数据，只需复制以开头的部分 IE.Navigate "https://www.pagewhereyourdatayouwanttoextractis.com" 并停止 Range("Y2").Value = dd

当然，这取决于您要从中提取数据的页面是否具有与上述相似的结构。

希望这可以帮助一些人。

最好的问候