版本:Microsoft Visual Basic for Applications 7.1
我正在开展一个小规模的数据挖掘/网络数据提取个人项目。我的问题是关于数据提取。
使用IE从网页中提取数据但运行速度非常慢,因此我倾向于使用XML HTTP请求。但是,当我在我打算工作的网站上试用它时,除了一些静态内容之外,我无法提取我需要的数据。在检查响应文本后,我发现它不包含我需要的数据。可能它是由JavaScript或类似技术生成的。我不确定这些脚本是否使用XML HTTP请求在VBA中呈现,就像在Web浏览器中一样。
此外,有趣的是,在检查开发人员工具>网络的网页时,它提供了一个Request URL,其中响应包含我需要的大部分数据,但它是JSON格式。我不知道如何解析它,但我刚刚提供了这些信息,因此您可以指出我正确的方向,以防万一使用XML HTTP请求从动态网页中提取数据是不可能的。
我希望您可以花几分钟时间查看我的代码以及我可能在哪里做错了。
非常感谢你们。我非常感谢你的帮助。
这是我正在尝试做的基本想法:
使用XML(无法提取所需的数据):
Option Explicit
Sub dataMinExProject_XML()
Dim xmlPage As MSXML2.XMLHTTP60
Dim htmlDoc As MSHTML.HTMLDocument
Dim coName As MSHTML.IHTMLElement
Dim secSym As MSHTML.IHTMLElement
Dim closePrice As MSHTML.IHTMLElement
Dim URL As String
URL = "https://www.pse.com.ph/stockMarket/companyInfo.html?id=260&security=468&tab=0"
Set xmlPage = New MSXML2.XMLHTTP60
With xmlPage
.Open "POST", URL, False
.send
End With
Do Until xmlPage.ReadyState = 4
DoEvents
Loop
Set htmlDoc = New MSHTML.HTMLDocument
htmlDoc.body.innerHTML = xmlPage.responseText
Set coName = htmlDoc.getElementById("comTopInfoHead").Children(0)
Set secSym = htmlDoc.getElementById("secSymbol")
Set closePrice = htmlDoc.getElementById("headerLastTradePrice")
Debug.Print "Company Name: ", """" & coName.innerText & """"
Debug.Print "Security Symbol: ", """" & secSym.innerText & """"
Debug.Print "Closing Price: ", """" & closePrice.innerText & """"
xmlPage.abort
Set xmlPage = Nothing
MsgBox ("alright!")
End Sub
Immediate Window
Company Name: "BDO Unibank, Inc."
Security Symbol: ""
Closing Price: " "
在检查立即窗口时,它表明没有提取Security Symbol
和Closing Price
。
仅仅为了比较,并且为了证明要提取的数据存在,我还在这里提供了使用IE实例的代码。
使用IE(提取数据但运行速度相对较慢):
Option Explicit
Sub dataMinExProject_IE()
Dim ieApp As SHDocVw.InternetExplorer
Dim htmlDoc As MSHTML.HTMLDocument
Dim coName As MSHTML.IHTMLElement
Dim secSym As MSHTML.IHTMLElement
Dim closePrice As MSHTML.IHTMLElement
Dim URL As String
URL = "https://www.pse.com.ph/stockMarket/companyInfo.html?id=260&security=468&tab=0"
Set ieApp = New SHDocVw.InternetExplorer
With ieApp
.Navigate (URL)
.Visible = vbTrue
End With
Do Until ieApp.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
Set htmlDoc = ieApp.Document
Set coName = htmlDoc.getElementById("comTopInfoHead").Children(0)
Set secSym = htmlDoc.getElementById("secSymbol")
Set closePrice = htmlDoc.getElementById("headerLastTradePrice")
Do Until secSym.innerText <> vbNullString And closePrice.innerText <> vbNullString
Loop
DoEvents
Debug.Print "Company Name: ", """" & coName.innerText & """"
Debug.Print "Security Symbol: ", """" & secSym.innerText & """"
Debug.Print "Closing Price: ", """" & closePrice.innerText & """"
ieApp.Quit
Set ieApp = Nothing
MsgBox ("alright!")
End Sub
Immediate Window
Company Name: "BDO Unibank, Inc."
Security Symbol: "BDO"
Closing Price: "130.50"
查看立即窗口,它显示它已成功提取数据。但是,正如我之前所说,其糟糕的表现让我看到其他选择..
参考文献:
使用HTTP请求是可行的方法。正如你所说IE慢,效率低。
找到返回您感兴趣的数据作为响应的请求后,您的工作相对容易,并且很可能涉及以下之一:
Microsoft HTML Object Library
,将响应HTML分配给HTMLDocument
并使用现有方法解析对象。为此你需要参考Microsoft HTML Object Library
。JSON
字符串。在这种情况下,您可以将响应存储在字符串变量中,并使用VBA JSON将其解析为json对象。链接中给出的说明和示例非常有用。使用在线JSON查看器来了解响应的结构,您将能够提取所需的任何信息。为此,您需要参考Microsoft Scripting Runtime
以及VBA JSON
模块。就请求本身而言,请确保使用对请求至关重要的标头。标题Content-Type:
是其中之一,它对POST
请求至关重要。您可以使用.setRequestHeader
方法。请求的主体包含请求的参数,也是必不可少的。我建议你使用WinHTTP Services, version 5.1
来满足你的要求。
掌握了这些内容后,您将完全控制要检索的数据。
有一套APIs。目前Stock API端点似乎不起作用。我提出了一个问题。如果它再次工作,您可以使用以下语法。 json解析器是jsonconverter.bas。您将.bas添加到项目中并转到VBE>工具>引用>添加对Microsoft Scripting运行时的引用
Option Explicit
Public Sub dataMinExProject_XML()
Dim xmlPage As MSXML2.XMLHTTP60, aDate As String, symbol As String, json As Object, url As String
Set xmlPage = New MSXML2.XMLHTTP60
aDate = Format$(Date - 1, "MM-DD-YYYY")
symbol = "JFC"
url = "http://pseapi.com/api/Stock/" & symbol & "/" & aDate
With xmlPage
.Open "GET", url, False
.send
Set json = JsonConverter.ParseJson(.responseText)
End With
End Sub
它返回一个字典对象,您可以按键解析信息
{
"symbol":"JFC",
"date":"15/03/2017",
"open":197.0000,
"high":197.4000,
"low":195.0000,
"close":196.0000,
"bid":195.5000,
"ask":196.0000,
"volume":141740,
"value":27747934.0000,
"netForeign":-6464136.0000
}
所以,对于我的例子:
Dim key As Variant
For Each key In json.keys
Debug.Print key, json(key)
Next