以下代码能将第一网站的融资融券余额提取放在当前工作表的A1单元格中。你用一下,如果明后天也能使用,说明网站数据结构是固定的,那我再给你做提取第二个网站的。需要的话就追问一下。
Sub 提取融资融券余额()
Set xm = CreateObject("Msxml2.XMLHTTP.3.0")
xm.Open "GET", "http://www.szse.cn/main/disclosure/rzrqxx/rzrqjy/", False
xm.send
s = StrConv(xm.responsebody, vbUnicode)
[A1] = Val(Replace(Split(s, "class='cls-data-td' align='right' >")(6), ",", ""))
End Sub
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Integer, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Integer, ByVal lpfnCB As Integer) As Long
Sub getdata()
url = "http://www.szse.cn/szseWeb/FrontController.szse?ACTIONID=8&CATALOGID=1837_xxpl&tab2PAGENUM=1&ENCODE=1&TABKEY=tab1"
'url = StrConv(url, vbUnicode)
'DoFileDownload url
fpath = ThisWorkbook.Path & "\1.xls"
URLDownloadToFile 0, url, fpath, 0, 0
Application.ScreenUpdating = False
Workbooks.Open fpath
ActiveWorkbook.Sheets(1).Range("a1:f2").Copy
ThisWorkbook.Sheets(1).Range("a1:f2").PasteSpecial xlPasteAll
ActiveWorkbook.Close
Kill fpath
Application.ScreenUpdating = True
End Sub
这是第一个网站的数据,数据在第一个表的a1:f2,原理是从它提供的地址下载xls文件,然后打开复制粘贴到vba所在xls文件,由于不知道地址是否固定,所以不知道明天是否能用,请测试;第二个网站类似,请尝试照葫芦画瓢。
Sub cc()
Cells.ClearContents
Set oDoc = CreateObject("htmlfile")
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET",
"http://www.wzyunying.com/transparent.do?method=spxlList&tasktype=xb&nowYearM=2014-04&acceptid=&applyTypeCde=IND&isTimetag=0&pageMaxNumber=360&pagenum=1",
False
.Send
.WaitForResponse
oDoc.body.innerHTML = .responsetext
Set r = oDoc.All.tags("table")(7).Rows
For i = 0 To r.Length - 1
k = [a65536].End(3).Row
For j = 0 To r(i).Cells.Length - 1
Cells(k + 1, j + 1) = r(i).Cells(j).innerText
Next j
Next i
Set r = Nothing
End With
End Sub