Ryc*_*ket 5 html excel vba excel-vba web-scraping
我一直试图找到这些信息几天,但我发现的所有例子都只有一小部分代码,我需要全部=)
我想要做的是从主页中提取一个值并将其放入Excel中的单元格中(然后从同一站点上的另一个页面获取另一个值并放入下一个单元格等等)
该页面是瑞典的股票交易所页面,我用作测试页面的页面是"投资者B"的股票(https://www.avanza.se/aktier/om-aktien.html/5247 /投资者-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>
Run Code Online (Sandbox Code Playgroud)
这是我追求的价值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
Run Code Online (Sandbox Code Playgroud)
编辑: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
Run Code Online (Sandbox Code Playgroud)
在module1中
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
Run Code Online (Sandbox Code Playgroud)
如前所述,我不知道我是否使用这个最新的加载项得到了正确的结构,而不是在这种编码中过期我害怕.
最好的祝福
停止编辑2014-05-12 17:08
你很近但有一些小错误.
这是我如何设置它(测试):
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
Run Code Online (Sandbox Code Playgroud)
结果:

在Excel 2010中测试,包含以下参考:

编辑 - 选项B.
要摆脱可能的"运行时错误'91'",请尝试更改以下几行:
Dim dd As Variant
Set dd = IE.Document.getElementsByClassName("lastPrice SText bold")
MsgBox dd(0).textContent
Run Code Online (Sandbox Code Playgroud)
编辑 - 选项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
Run Code Online (Sandbox Code Playgroud)
(这三种方法都已在Excel 2010和IE10上测试过)