求Excel VBA代码才用XMLHTTP的方法提取一网页内表格?
网页地址为http://f9.eastmoney.com/soft/gp13.php?code=00000202,求完整vba代码,要求才用XMLHTTP的方法提取该表格...
网页地址为http://f9.eastmoney.com/soft/gp13.php?code=00000202,求完整vba代码,要求才用XMLHTTP的方法提取该表格。最好对代码作个注释。
展开
2个回答
展开全部
分析好久才弄出来的,经实测成功,望采纳...
Sub test()
Dim strUrl$, objHttp As Object, strRtn, arrRtn, i%, j%
strUrl = "http://f9.eastmoney.com/soft/gp13.php?code=00000202"
Set objHttp = CreateObject("msxml2.xmlhttp")
objHttp.Open "GET", strUrl, 0
objHttp.send
While objHttp.readystate <> 4
DoEvents
Wend
Cells.Clear '清除表格内容
Rows(2).NumberFormatLocal = "@" '第二行设置为文本格式
'取 "<table" 之后的内容
strRtn = Split(objHttp.responsetext, "<table", -1, vbTextCompare)(1)
'以 "<tr>" 作为分隔符把数据分为行数组
strRtn = Split(strRtn, "<tr>", -1, vbTextCompare)
For i = 0 To UBound(strRtn) '行循环
'各个字段以 "<span>" 分隔
arrRtn = Split(strRtn(i), "<span>", -1, vbTextCompare)
For j = 1 To UBound(arrRtn) '列循环
'取"</span>"之前的内容,并且把" "替换为空,然后输出到表格里
Cells(i + 1, j + 1) = Replace(Split(arrRtn(j), "</span>", -1, vbTextCompare)(0) _
, " ", "", 1, -1, vbTextCompare)
Next j
Next i
Set objHttp = Nothing
MsgBox "done..."
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询