发起

Excel 新浪行情接口修复方法

收藏 关注

2022-01-21 16:12 根据新浪接口更新了代码，再修复一次

打开VBA编辑器
WinHttp.XMLHTTP 替换 成 WinHttp.WinHttpRequest.5.1
在 .send 前面加 .setRequestHeader "Referer", "http://finance.sina.com.cn/"

例如我这个用的这个函数原先是：
With CreateObject("WinHttp.XMLHTTP")
    .Open "GET", url, False
    .Send
    sTemp = .responseText
End With
改成下面的就正常了
With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "GET", url, False
    .setRequestHeader "Referer", "http://finance.sina.com.cn/"
    .Send
    sTemp = .responseText
End With



==============

获取新浪行情的完整函数

Sub GetNetValueDetail(ByVal sheet As Worksheet, beginCol As String) '基金查询
Dim rowCount As Integer
Dim url As String
Dim sTemp As String

rowCount = sheet.Range("A65535").End(xlUp).Row '获取行数

url = "http://hq.sinajs.cn/list=" '新浪行情数据接口
For i = 2 To rowCount '从第二行开始，第一列为股票代码
    code = sheet.Range("A" & i).Text
    If Len(code) < 6 Then
        code = "unknow"
    Else
        code = "of" & Right(code, 6) '基金代码前of(open fund)
    End If
    If i = 2 Then
        url = url & code
    Else
        url = url & "," & code
    End If
Next i

'获取新浪股票行情数据，放入sTemp变量
With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "GET", url, False
    .setRequestHeader "Referer", "http://finance.sina.com.cn/"
    .Send
    sTemp = .responseText
End With

splits = Split(sTemp, ";")
For i = 0 To rowCount - 1
   mystr = splits(i)
   ss = InStr(mystr, ",")
   If ss > 1 Then
       startindex = InStr(1, mystr, """")
       endindex = InStrRev(mystr, """")
       substr = Mid(mystr, startindex + 1, endindex - startindex - 1) '引号中的有效数据
       valuearray = Split(substr, ",")

       begin = Asc(beginCol)
       J = 0
       sheet.Range(Chr(begin + J) & i + 2).Value = valuearray(0) '名称
       J = J + 1
       sheet.Range(Chr(begin + J) & i + 2).Value = valuearray(1) '净值
       J = J + 1
       sheet.Range(Chr(begin + J) & i + 2).Value = valuearray(2) '累计净值
       J = J + 1
       sheet.Range(Chr(begin + J) & i + 2).Value = valuearray(3) '上日净值
       J = J + 1
       sheet.Range(Chr(begin + J) & i + 2).Value = Format(valuearray(4) / 100, "0.00%") '净值涨跌幅
       sheet.Range(Chr(begin + J) & i + 2).Font.Color = GetFontColor(valuearray(1) - valuearray(3))
       J = J + 1
       sheet.Range(Chr(begin + J) & i + 2).Value = valuearray(5)  '日期
   End If
Next i
End Sub
发表时间 2022-01-21 10:31     最后修改时间 2022-01-21 16:13
分享

赞同来自: 牛肉干 、小小小升 、数据分析 、醉虾 、Iloveqi 、sniu 、yyttcc705 、Louishe 、良人不是我 、墙角数枝梅 、xiaoysd 、湖源山人 、flyzizai 、天上街市 、一口跳跳糖 、xineric 、leofa 、star 、mmtian 、gy100200 、cherub168 、得心应手到擒来 、许NICK 、chenzhi999 、asdsky2000 、lwm1518ss 、gcci 、gzsamchen 、力不尽则憾 、Shawlock 、流沙少帅 、基坛子龙 、奇异世界 、hydk 、adodo 、zhangyeats 、maliang28 、neptunus 、家的港湾 、天地玄黄宇宙洪 、万法如幻 、BingoYou 、投资161812 、booboo 、leonyuan 、Skyzh1 、lawsunyer 、suijimanbu 、Slowton 、pqfund 、bakehuang 、yedn 、黄JJ 、w狼图腾w 、范闻 、deanlo更多 »

    160 个回复

1

铆钉

赞同来自: 慎之又胜

@玲音
strHeaders = _T("Referer:http://finance.sina.com.cn/";);
CHttpFile* pFile = (CHttpFile*)session.OpenURL((LPCTSTR)strUrl, 1, INTERNET_FLAG_TRANSFER_ASCII | INTERNET_FLAG_RELOAD | INTERNET_FLAG_DONT_CAC...
抱歉，对C++语言不熟悉
2022-01-21 21:20修改 引用
2

铆钉

赞同来自: zddd10 、beron1688

@beron1688
请问楼主，我的改了后还是不行。请假解决办法。谢谢楼主！
Sub 获取价格_Click()
Dim rowCount As Integer
Dim url As String
Dim sTemp As String
With Application
.Calculation = xlManual
.MaxChange = 0.001
End W...
With CreateObject("Microsoft.XMLHTTP")
改成 With CreateObject("WinHttp.WinHttpRequest.5.1")
2022-01-21 21:16修改 引用
1

beron1688

赞同来自: 路履薄冰

请问楼主，我的改了后还是不行。请假解决办法。谢谢楼主！
Sub 获取价格_Click()
Dim rowCount As Integer
Dim url As String
Dim sTemp As String
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With

rowCount = Range("A65535").End(xlUp).Row '获取行数
url = "http://hq.sinajs.cn/list="
For i = 2 To rowCount
If i = 2 Then
url = url & Range("A" & i).Text
Else
url = url & "," & Range("A" & i).Text
End If
Next i

'获取新浪股票行情数据，放入sTemp变量
With CreateObject("Microsoft.XMLHTTP")
.Open "GET", url, False
.setRequestHeader "Referer", "http://finance.sina.com.cn/"
.send
sTemp = .responseText
End With

splits = Split(sTemp, ";")
For i = 0 To rowCount
mystr = splits(i)
ss = InStr(mystr, ",")
If ss < 1 Then '代码解析不了，退出
Exit For
End If

startIndex = InStr(1, mystr, """")
endIndex = InStrRev(mystr, """")
subStr = Mid(mystr, startIndex + 1, endIndex - 1)
valueArray = Split(subStr, ",") '共有32个数据 ，包括了股票名称，价格等信息

'以下取数据，省略了买1至买5，卖1至卖5
Range("B" & i + 2).Value = valueArray(0) '名称

Range("C" & i + 2).Value = valueArray(3) '当前价

Range("D" & i + 2).Value = valueArray(6) '买一
Range("E" & i + 2).Value = valueArray(7) '卖一
Range("f" & i + 2).Value = valueArray(2) '昨收盘

Next i
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
Call Sheet1.time
End Sub
2022-01-21 21:00 引用
0

ccnuwater

赞同来自:

@coyoo
果然把maxCountPer = 700 ' 每30行一读取修改下就好了
谢谢大神，终于解决了这个问题。
2022-01-21 19:35 引用
0

Carby

赞同来自:

我改用腾讯了，腾讯也禁了再想办法
2022-01-21 18:10 引用
0

玲音

赞同来自:

strHeaders = _T("Referer:http://finance.sina.com.cn/";);
CHttpFile* pFile = (CHttpFile*)session.OpenURL((LPCTSTR)strUrl, 1, INTERNET_FLAG_TRANSFER_ASCII | INTERNET_FLAG_RELOAD | INTERNET_FLAG_DONT_CACHE,strHeaders, 0);
C++版本的增加这个header后依然不行，请教楼主可有解决方法？
2022-01-21 17:43修改 引用
0

jlymj

赞同来自:

感谢楼主，太及时了
2022-01-21 17:02 引用
0

scutzyl

赞同来自:

没发搞了？
2022-01-21 16:52 引用
0

家的港湾

赞同来自:

@铆钉 感谢了 可以了!
2022-01-21 16:34 引用
0

coyoo

赞同来自:

没搞头了？
2022-01-21 16:13 引用
0

唐唐1224 - 众生皆苦,唯有自渡,天意无常,顺其自然。

赞同来自:

@铆钉 感谢了 可以了
2022-01-21 16:13 引用
2

Twenty

赞同来自: 慕容吹雪 、lsx1763

好像又不行了。
2022-01-21 16:11 引用
4

铆钉

赞同来自: zddd10 、初学才会 、慕容吹雪 、Skyzh1

@唐唐1224
又被禁了。。。
我同样也打不开了
更新代码了

在 .send 前面加 .setRequestHeader "Referer", "http://finance.sina.com.cn/"
2022-01-21 16:10 引用
0

铆钉

赞同来自:

@Skyzh1
好像新浪把这个方法也给禁止了
更新代码了

在 .send 前面加 .setRequestHeader "Referer", "http://finance.sina.com.cn/"
2022-01-21 16:10 引用
0

唐唐1224 - 众生皆苦,唯有自渡,天意无常,顺其自然。

赞同来自:

又被禁了。。。
我同样也打不开了
2022-01-21 16:06 引用
1

Skyzh1

赞同来自: 被E拯救

好像新浪把这个方法也给禁止了
2022-01-21 16:02 引用
0

topiceman

赞同来自:

请教各位大神，Matlab里面应该怎么修改，好像没找到应该如何设置Referer，非常感谢。
2022-01-21 15:57 引用
0

大掌柜

赞同来自:

感谢楼主！楼主大爱！
2022-01-21 15:41 引用
0

天地玄黄宇宙洪

赞同来自:

今天发现不行了，正愁怎么改呢，楼主真是股民的大救星啊。
2022-01-21 15:31 引用
0

Lee158

赞同来自:

@铆钉
Set objXML = CreateObject("Microsoft.XMLHTTP")
With objXML
.Open "Get", Url, False, "", ""
.Send
这个改成
Set objXML = CreateObject("WinHttp.WinHttpRequest.5.1")
With objXML
.Open "Get", Url, False, "", "...
改了以后，If xmlobject.readystate = 4 Then 这个报错了，对象不支持该属性
2022-01-21 15:17 引用
0

coyoo

赞同来自:

@铆钉 能不能将下面2句代码合并？将第二句加入到“Url”里？
.Open "Get", Url, False, "", ""
.setRequestHeader "Referer", "finance.sina.com.cn"
2022-01-21 15:12 引用
0

黄JJ

赞同来自:

@coyoo
@黄JJ 将你的代码里的下一段，依据楼主说的修改就行了
Set objXML = CreateObject("Microsoft.XMLHTTP")
With objXML
.Open "Get", Url, False, "", ""
.Send
GetHttp = .ResponseBody
End With
可以了，谢谢啊
2022-01-21 15:10 引用
0

铆钉

赞同来自:

@黄JJ
大哥，能不能详细点怎么改啊，最好直接贴改好的出来，完全不懂编程。
Set objXML = CreateObject("Microsoft.XMLHTTP")
With objXML
.Open "Get", Url, False, "", ""
.Send

改成

Set objXML = CreateObject("WinHttp.WinHttpRequest.5.1")
With objXML
.Open "Get", Url, False, "", ""
.setRequestHeader "Referer", "finance.sina.com.cn"
.Send
2022-01-21 15:09 引用
0

lsx1763

赞同来自:

谢谢楼主，数据好像能更新了，不懂再来请教，再次感谢
2022-01-21 15:00 引用
0

黄JJ

赞同来自:

@coyoo
@黄JJ 将你的代码里的下一段，依据楼主说的修改就行了
Set objXML = CreateObject("Microsoft.XMLHTTP")
With objXML
.Open "Get", Url, False, "", ""
.Send
GetHttp = .ResponseBody
End With
大哥，能不能详细点怎么改啊，最好直接贴改好的出来，完全不懂编程。
2022-01-21 14:57 引用
0

铆钉

赞同来自:

@Lee158
不同懂语言，这个认证语句是要放在什么位置
strUrl = "http://hq.sinajs.cn/list=" & Code(i) & Cells(1 + i, 1) '起始代码单元格
xmlobject.Open "GET", strUrl, False
xmlobject.setRequestHeader " Referer", "https://finance.sina....
Set objXML = CreateObject("Microsoft.XMLHTTP")
With objXML
.Open "Get", Url, False, "", ""
.Send

这个改成

Set objXML = CreateObject("WinHttp.WinHttpRequest.5.1")
With objXML
.Open "Get", Url, False, "", ""
.setRequestHeader "Referer", "finance.sina.com.cn"
.Send
2022-01-21 14:56 引用
1

铆钉

赞同来自: lsx1763

@lsx1763
按楼主的改了，但系统还是提示错误：运行时错误'9': 下标越界；请问要怎样改
WinHttp.XMLHTTP 替换 成 WinHttp.WinHttpRequest.5.1

这个你没改
2022-01-21 14:52 引用
0

BingoYou - Hope for the best, Plan for the worst!

赞同来自:

多谢楼主，昨晚就发现了新浪接口的问题，今天就看到楼主的修复方法了。
2022-01-21 14:45 引用
0

zhida099

赞同来自:

搞定，非常感谢！
2022-01-21 14:38 引用
0

bukubuku

赞同来自:

谢谢楼主，楼主v587
2022-01-21 14:36 引用
0

冰糖葫芦娃8

赞同来自:

马克一下，感谢楼主分享
2022-01-21 14:34 引用
0

coyoo

赞同来自:

@黄JJ 将你的代码里的下一段，依据楼主说的修改就行了
Set objXML = CreateObject("Microsoft.XMLHTTP")
With objXML
.Open "Get", Url, False, "", ""
.Send
GetHttp = .ResponseBody
End With
2022-01-21 14:33 引用
0

Lee158

赞同来自:

不同懂语言，这个认证语句是要放在什么位置

strUrl = "http://hq.sinajs.cn/list=" & Code(i) & Cells(1 + i, 1) '起始代码单元格
xmlobject.Open "GET", strUrl, False
xmlobject.setRequestHeader " Referer", "https://finance.sina.com.cn"
xmlobject.send
If xmlobject.readystate = 4 Then
strReturn = xmlobject.responsetext
intLen = Len(strReturn) - 25 '剔除无关数据
strReturn = Mid(strReturn, 22, intLen)
arry = Split(strReturn, ",") '按逗号分隔数据，放入数组arry
intLenA = UBound(arry) - LBound(arry) + 1 '数组长度，此处未使用，可结合For遍历arry

'获取目标数据
Cells(1 + i, 3) = arry(3) '现值
Cells(1 + i, 4) = arry(3) - arry(2) '幅度差
Cells(1 + i, 5) = Round((arry(3) - arry(2)) / arry(2), 4) '幅度百分比
Cells(1 + i, 6) = arry(8) / 100 '量
Cells(1 + i, 2) = arry(0)
End If
Next i
2022-01-21 14:32 引用
0

投资161812

赞同来自:

谢谢，早上发现不对劲第一时间切换到大智慧的DLL接口上，准备改一改再切回来新浪接口，稳定性上感觉：新浪>大智慧>腾讯，后面两个经常需要重启。
2022-01-21 14:32 引用
0

黄JJ

赞同来自:

Function FormatDate(ByRef strDate As String)
iYear = Mid(strDate, 1, 4)
iMonth = Mid(strDate, 5, 2)
iDay = Mid(strDate, 7, 2)

FormatDate = iYear + "-" + iMonth + "-" + iDay
End Function

Function gp3(ByRef StockCode As String)
Application.Volatile '定义为易失性函数(每次需要重新计算)
Url = "http://hq.sinajs.cn/list=" + StockCode
strData = GetHttp(Url)
strData = Replace(strData, Chr(13), "") '替换换行符
strData = Replace(strData, Chr(10), "") '替换回车符

Set objREGEXP = CreateObject("VBSCRIPT.REGEXP") 'note定义了一个正则表达式，去除http返回的前面一堆乱七八糟的头
With objREGEXP
.Global = True
.Pattern = "var hq_str_.*=\"""
strData = .Replace(strData, "")
.Pattern = "\"";"
strData = .Replace(strData, "")

End With
Set objREGEXP = Nothing

StockData = Split(strData, ",") '将strData通过Split函数分开,split函数返回一个包含各种数据的数组
gp3 = Val(StockData(3))
End Function

Function GetHttp(Url)
Dim objXML
On Error Resume Next
Set objXML = CreateObject("Microsoft.XMLHTTP")
With objXML
.Open "Get", Url, False, "", ""
.Send
GetHttp = .ResponseBody
End With
GetHttp = BytesToBstr(GetHttp, "GB2312")
Set objXML = Nothing
On Error GoTo 0
End Function

Function BytesToBstr(strBody, CodeBase)
Dim objStream
Set objStream = CreateObject("Adodb.Stream")

With objStream
.Type = 1
.Mode = 3
.Open
.Write strBody
.Position = 0
.Type = 2
.Charset = CodeBase
BytesToBstr = .ReadText
End With
objStream.Close
Set objStream = Nothing
End Function
请教下这个要怎么修复？
2022-01-21 14:18 引用
0

coyoo

赞同来自:

果然把maxCountPer = 700 ' 每30行一读取修改下就好了
2022-01-21 14:12 引用
0

coyoo

赞同来自:

发现第32行读取的数据不是基金现价，而是昨天收盘的净值数据


注意看最后一列的时间，其它正确的都是13点，只有32行是15：00
2022-01-21 14:07 引用
0

黄JJ

赞同来自:



请教下这个要怎么改？
2022-01-21 13:48 引用
0

walter97

赞同来自:

早上我哈以为是网络问题,想等等再看,无意看了集思录好几个讨论excel的帖子才意识到是网页更新了.看来大家手上的新浪excel都是老版本,一个出处.呵呵
2022-01-21 13:39 引用
0

路履薄冰

赞同来自:

@yedn
是的，从32行开始代码和后面的信息错位了
改30 改成几百再空一格，可以了
2022-01-21 13:35 引用
0

路履薄冰

赞同来自:

我的版本错行，水平差没办法搞定，只好改成大点数据，我改成700了，空一行暂时可以了，等高手改bug
Sub GetPriceDetail(ByVal sheet As Worksheet) '详细版，(名称,价格，涨幅，振幅，最高价，最低价，成交额，更新时间)
Dim rowCount As Integer
Dim URL As String
Dim sTemp As String

rowCount = sheet.Range("A65535").End(xlUp).Row '获取行数

maxCountPer = 700 ' 每30行一读取
num = Int((rowCount - 1) / maxCountPer)

For kk = 0 To num
URL = "http://hq.sinajs.cn/list="
For jj = 2 To maxCountPer
ii = kk * maxCountPer + jj + 1
If ii <= rowCount Then
code = sheet.Range("A" & ii).Text
If Len(code) < 6 Then
code = "unknow"
End If
If ii = 2 Then '从第二行开始
URL = URL & code
Else
URL = URL & "," & code
End If
End If
Next jj

'获取新浪股票行情数据，放入sTemp变量

With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", URL, False
.setRequestHeader "Referer", "http://finance.sina.com.cn"
.Send
sTemp = .responseText
End With
2022-01-21 13:34 引用
0

Skyzh1

赞同来自:

楼主威武
2022-01-21 13:26 引用
0

coyoo

赞同来自:

确实有错行的问题
2022-01-21 13:20 引用
0

初学才会

赞同来自:

搞定~~~感谢楼主！！！！
2022-01-21 13:18 引用
0

温酒斩华佗

赞同来自:

我也是，今天一打开连接不了，然后在浏览器抓包，把头部文件编辑一下，就可以了。
2022-01-21 13:09 引用
0

修身明德

赞同来自:

感谢，搞定了。
2022-01-21 12:58 引用
0

bihaishi

赞同来自:

高手，感谢不尽！
2022-01-21 12:52 引用
0

shengypc

赞同来自:

一样，第30多行开始代码错位了
2022-01-21 12:46 引用
0

百分之十先生

赞同来自:

搞定，感谢！
2022-01-21 12:37 引用
0

鸣人吃土豆

赞同来自:

朋友，求发文件，感谢
2022-01-21 12:33 引用
0

gbcdbj

赞同来自:

兄弟，发一下excel文件
2022-01-21 12:27 引用
0

yedn

赞同来自:

@路履薄冰
为什么代码排序全乱了
是的，从32行开始代码和后面的信息错位了
2022-01-21 12:12 引用
0

PEPPER2018

赞同来自:

谢谢了楼主讲解
2022-01-21 12:10 引用
0

cjhren

赞同来自:

正解
2022-01-21 11:59 引用
1

黄JJ

赞同来自:

股民不紧要上知天文下知地理，还要懂编程，太累了。
2022-01-21 11:59 引用
0

花园小琴

赞同来自:

兄弟，发一下excel文件
2022-01-21 11:47 引用
0

bakehuang

赞同来自:

多谢
2022-01-21 11:39 引用
0

路履薄冰

赞同来自:

为什么代码排序全乱了
2022-01-21 11:35 引用
0

littledou

赞同来自:

多谢，搞定。
2022-01-21 11:19 引用
0

longinv

赞同来自:

这么快就有人发表VBA的修复办法了哈哈哈哈
2022-01-21 10:54 引用

要回复问题请先登录或注册

发起人

铆钉
铆钉

问题状态

  • 最新活动: 2023-09-21 06:31
  • 浏览: 38475
  • 关注: 241 人
京公网安备 11010802031449号    京ICP证160493号  京ICP备12044618号-1
  用户协议   隐私政策   问题反馈   客服邮箱：service@jisilu.com   |  ©2012-2024 - 集思录版权所有
使用Chrome浏览本站最佳  |  声明：本站所有收费以及免费的信息和数据仅供参考，不构成投资建议，集思录不承担由此导致的任何责任。