|
除非注明，文章均为 战战如疯 原创，转载请保留链接: http://www./cat3/531.html，VBA交流群273624828。
之前的文章中讲过东方财富网数据的下载，因为网站改版的原因原来的程序失效了，有不少网友把网址一换发现不行就来问我怎么程序不好用？网抓程序在处理方法上是相同的，但是在处理细节方面有很大的不同，很多不懂的网友以为改个网址就可以通用，如果你也只是到这种程序就不要来问我为什么不能用或者让我来给你重新写代码了。虽然网上有不少人会帮人做义工，但我不是其中之一，尤其是玩彩票和股票的朋友，如果你有这种需要但又不舍得花钱那还是不要来找我了。
言归正传，这次我们仍然来看看之前课程中那个网址的数据，http://data.eastmoney.com/executive/list.html，改版之后我们进行抓包所得到的网址是http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=GG&sty=GGMX&p=2&ps=50&js=var%20VVAUuXKL={pages:(pc),data:[(x)]}&rt=47184514。之前我们处理的时候用的是split处理字符串的方法，这次我们用JSON方法来处理得到的字符串。
这里我们只取一页数据来做例子。
Sub test()
Dim winhttp, URL, arr, i, j, p, t, objJS, objS, pages, n
Sheet1.Cells.Clear
Set winhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
Set objJS = CreateObject("MSScriptControl.ScriptControl")
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
With winhttp
URL = "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=GG&sty=GGMX&p=1&ps=50&js=var VVAUuXKL={pages:(pc),data:[(x)]}&rt=47184514"
.Open "GET", URL, False
.setRequestHeader "Connection", "Keep-Alive"
.send
t = .responsetext
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") '调试用，数据放入剪贴板
.SetText t
.PutInClipboard
End With
With objJS
.Language = "javascript"
.addcode t
Set objS = .codeobject
pages = CallByName(CallByName(objS, "VVAUuXKL", VbGet), "pages", VbGet)
Debug.Print pages
For Each p In CallByName(CallByName(objS, "VVAUuXKL", VbGet), "data", VbGet)
n = n + 1
arr = Split(p, ",")
Cells(n, 1).Resize(1, UBound(arr) + 1) = arr
Next
End With
End With
Set winhttp = Nothing
Set arr = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
得到数据并不难，主要在数据的处理上有些东西要注意，不明白的朋友请自行百度关于JSON的知识。
|
