Edge
Chrome
Firefox
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
0
@ccnuwater
sheet.Range(Chr(begin + j) & i + 2).Value = Format(valueArray(1) / valueArray(3) - 1, "0.00%") '净值涨跌幅
sheet.Range(Chr(begin + j) & i + 2).Font.Color = GetFontColor(valueArray(1) - valueArray(3))
我这样修改后，显示错误：运行时错误13，类型不匹配。j = j + 1
点击提示时，这段提示有问题： sheet.Range(Chr(begin + J) & i + 2).Value = Format(valuearray(4) / 100, "0.00%") '净值涨跌幅
不知道怎么解决？
sheet.Range(Chr(begin + j) & i + 2).Value = Format(valueArray(1) / valueArray(3) - 1, "0.00%") '净值涨跌幅
sheet.Range(Chr(begin + j) & i + 2).Font.Color = GetFontColor(valueArray(1) - valueArray(3))
0
@ccnuwater
我这样修改后，显示错误：运行时错误13，类型不匹配。点击提示时，这段提示有问题： sheet.Range(Chr(begin + J) & i + 2).Value = Format(valuearray(4) / 100, "0.00%") '净值涨跌幅不知道怎么解决？
0
@ccnuwater
我这样修改后，显示错误：运行时错误13，类型不匹配。点击提示时，这段提示有问题： sheet.Range(Chr(begin + J) & i + 2).Value = Format(valuearray(4) / 100, "0.00%") '净值涨跌幅不知道怎么解决？看了下，Valuearray（4）在取出来的是日期，（Valuearray（1）-Valuearray（3））/Valuearray（3）改成应该可以
0
@ccnuwater
点击提示时，这段提示有问题： sheet.Range(Chr(begin + J) & i + 2).Value = Format(valuearray(4) / 100, "0.00%") '净值涨跌幅
不知道怎么解决？
code = "of" & Right(code, 6) '基金代码前of(open fund)我这样修改后，显示错误：运行时错误13，类型不匹配。
是将这个位置的of改为f_吗？
点击提示时，这段提示有问题： sheet.Range(Chr(begin + J) & i + 2).Value = Format(valuearray(4) / 100, "0.00%") '净值涨跌幅
不知道怎么解决？
0
创建请求时候，需要设置下.setRequestHeader "Referer", "http://finance.sina.com.cn/"
比如改成
.setRequestHeader "Referer", "https://finance.sina.com.cn/realstock/company/sz002354/nc.shtml"
这里引用URL 需要格式化对应证券代码 "https://finance.sina.com.cn/realstock/company/{XXXX证券代码}/nc.shtml"
比如改成
.setRequestHeader "Referer", "https://finance.sina.com.cn/realstock/company/sz002354/nc.shtml"
这里引用URL 需要格式化对应证券代码 "https://finance.sina.com.cn/realstock/company/{XXXX证券代码}/nc.shtml"
1
赞同来自: yubingem
@star
python 脚本：这个可以，谢谢分享
url=r'https://hq.sinajs.cn/list=sh510050'
headers = {"Referer": "http://finance.sina.com.cn/"}
r = requests.get(url, headers=headers)
print(r.text)
0
@star
python 脚本：谢谢您！在Python中运行着四行代码是没问题的。不过直接在浏览器输入网址 https://hq.sinajs.cn/list=sh510050 敲回车键时，它显示“Kinsoku jikou desu!，这是什么意思呢？
url=r'https://hq.sinajs.cn/list=sh510050'
headers = {"Referer": "http://finance.sina.com.cn/"}
r = requests.get(url, headers=headers)
print(r.text)
0
C++的那行从：
pfile = (CHttpFile*)session.OpenURL(url,1,INTERNET_FLAG_TRANSFER_ASCII||INTERNET_FLAG_RELOAD,NULL,0);
改成这样就行了:
pfile =(CHttpFile*)session.OpenURL(url,1,INTERNET_FLAG_TRANSFER_ASCII||INTERNET_FLAG_RELOAD,"Referer: https://finance.sina.com.cn",sizeof("Referer: https://finance.sina.com.cn";));
准备把大智慧的接口弄稳定点，刚查了一下，以前金融界和ChinaStock的接口都不提供了，新浪这个免费接口已经很久了。
pfile = (CHttpFile*)session.OpenURL(url,1,INTERNET_FLAG_TRANSFER_ASCII||INTERNET_FLAG_RELOAD,NULL,0);
改成这样就行了:
pfile =(CHttpFile*)session.OpenURL(url,1,INTERNET_FLAG_TRANSFER_ASCII||INTERNET_FLAG_RELOAD,"Referer: https://finance.sina.com.cn",sizeof("Referer: https://finance.sina.com.cn";));
准备把大智慧的接口弄稳定点，刚查了一下，以前金融界和ChinaStock的接口都不提供了，新浪这个免费接口已经很久了。
0
@玲音
CHttpFile* pFile = (CHttpFile*)session.OpenURL((LPCTSTR)strUrl, 1, INTERNET_FLAG_TRANSFER_ASCII | INTERNET_FLAG_RELOAD | INTERNET_FLAG_DONT_CACHE,strHeaders, 0);
改为：
CHttpFile* pFile = (CHttpFile*)session.OpenURL((LPCTSTR)strUrl, 1, INTERNET_FLAG_TRANSFER_ASCII | INTERNET_FLAG_RELOAD | INTERNET_FLAG_DONT_CACHE,strHeaders, strHeaders.GetLength());
strHeaders = _T("Referer:http://finance.sina.com.cn/";);OpenURL函数中最后一个参数赋值错误
CHttpFile* pFile = (CHttpFile*)session.OpenURL((LPCTSTR)strUrl, 1, INTERNET_FLAG_TRANSFER_ASCII | INTERNET_FLAG_RELOAD | INTERNET_FLAG_DONT_CAC...
CHttpFile* pFile = (CHttpFile*)session.OpenURL((LPCTSTR)strUrl, 1, INTERNET_FLAG_TRANSFER_ASCII | INTERNET_FLAG_RELOAD | INTERNET_FLAG_DONT_CACHE,strHeaders, 0);
改为：
CHttpFile* pFile = (CHttpFile*)session.OpenURL((LPCTSTR)strUrl, 1, INTERNET_FLAG_TRANSFER_ASCII | INTERNET_FLAG_RELOAD | INTERNET_FLAG_DONT_CACHE,strHeaders, strHeaders.GetLength());
1
赞同来自: 天地玄黄宇宙洪
python 脚本：
url=r'https://hq.sinajs.cn/list=sh510050'
headers = {"Referer": "http://finance.sina.com.cn/"}
r = requests.get(url, headers=headers)
print(r.text)
url=r'https://hq.sinajs.cn/list=sh510050'
headers = {"Referer": "http://finance.sina.com.cn/"}
r = requests.get(url, headers=headers)
print(r.text)
0
Sub a新浪()
Dim xmlobject As Object
Dim strReturn As String
Dim strUrl As String
Dim intLen As Long
Dim intLenA As Long
Dim arry As Variant
Dim vol(10) As Long
Dim Code(300) As String
Set xmlobject = CreateObject("WinHttp.WinHttpRequest.5.1")
'写入持仓表
For i = 8 To Cells(2, 9) - 1 '遍历，10等于当前行数
If Mid(Cells(1 + i, 1), 6, 1) = "" Then
Code(i) = "hk"
ElseIf Left(Cells(1 + i, 1), 2) = "11" Or Left(Cells(1 + i, 1), 2) = "01" Or Left(Cells(1 + i, 1), 2) = "13" Then
Code(i) = "sh"
ElseIf Left(Cells(1 + i, 1), 2) = "12" Or Left(Cells(1 + i, 1), 2) = "15" Or Left(Cells(1 + i, 1), 2) = "16" Or Left(Cells(1 + i, 1), 2) = "18" Then
Code(i) = "sz"
ElseIf Left(Cells(1 + i, 1), 1) = "6" Or Left(Cells(1 + i, 1), 1) = "5" Or Left(Cells(1 + i, 1), 1) = "9" Then
Code(i) = "sh"
ElseIf Left(Cells(1 + i, 1), 1) = "0" Or Left(Cells(1 + i, 1), 1) = "3" Or Left(Cells(1 + i, 1), 1) = "2" Then
Code(i) = "sz"
ElseIf Left(Cells(1 + i, 1), 1) = "8" Or Left(Cells(1 + i, 1), 1) = "4" Then
Code(i) = "sb"
Else
End If
strUrl = "http://hq.sinajs.cn/list=" & Code(i) & Cells(1 + i, 1) '起始代码单元格
xmlobject.Open "GET", strUrl, False
xmlobject.setRequestHeader "Referer", "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
改了后这行一直报错，无对象，请问怎么改If xmlobject.readystate = 4 Then
Dim xmlobject As Object
Dim strReturn As String
Dim strUrl As String
Dim intLen As Long
Dim intLenA As Long
Dim arry As Variant
Dim vol(10) As Long
Dim Code(300) As String
Set xmlobject = CreateObject("WinHttp.WinHttpRequest.5.1")
'写入持仓表
For i = 8 To Cells(2, 9) - 1 '遍历，10等于当前行数
If Mid(Cells(1 + i, 1), 6, 1) = "" Then
Code(i) = "hk"
ElseIf Left(Cells(1 + i, 1), 2) = "11" Or Left(Cells(1 + i, 1), 2) = "01" Or Left(Cells(1 + i, 1), 2) = "13" Then
Code(i) = "sh"
ElseIf Left(Cells(1 + i, 1), 2) = "12" Or Left(Cells(1 + i, 1), 2) = "15" Or Left(Cells(1 + i, 1), 2) = "16" Or Left(Cells(1 + i, 1), 2) = "18" Then
Code(i) = "sz"
ElseIf Left(Cells(1 + i, 1), 1) = "6" Or Left(Cells(1 + i, 1), 1) = "5" Or Left(Cells(1 + i, 1), 1) = "9" Then
Code(i) = "sh"
ElseIf Left(Cells(1 + i, 1), 1) = "0" Or Left(Cells(1 + i, 1), 1) = "3" Or Left(Cells(1 + i, 1), 1) = "2" Then
Code(i) = "sz"
ElseIf Left(Cells(1 + i, 1), 1) = "8" Or Left(Cells(1 + i, 1), 1) = "4" Then
Code(i) = "sb"
Else
End If
strUrl = "http://hq.sinajs.cn/list=" & Code(i) & Cells(1 + i, 1) '起始代码单元格
xmlobject.Open "GET", strUrl, False
xmlobject.setRequestHeader "Referer", "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
改了后这行一直报错，无对象，请问怎么改If xmlobject.readystate = 4 Then
0
Public Sub Getjingzhi()
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
Dim i As Integer
For i = 2 To 52
'创建XMLHttp对象
'构建并发送请求
'新浪接口
xmlHttp.Open "GET", "http://hq.sinajs.cn/rn=oya9k&list=f_" + Cells(i, 4), False
xmlHttp.Send
'等待响应
Do While xmlHttp.readyState <> 4
DoEvents
Loop
'接受响应结果
Dim strNum As String
strNum = xmlHttp.responseText
'处理响应结果
Dim strJZ As String
strJZ = Split(strNum, ",")(1)
Cells(i, 17) = strJZ
Next
End Sub
求教高手，这个怎么改？
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
Dim i As Integer
For i = 2 To 52
'创建XMLHttp对象
'构建并发送请求
'新浪接口
xmlHttp.Open "GET", "http://hq.sinajs.cn/rn=oya9k&list=f_" + Cells(i, 4), False
xmlHttp.Send
'等待响应
Do While xmlHttp.readyState <> 4
DoEvents
Loop
'接受响应结果
Dim strNum As String
strNum = xmlHttp.responseText
'处理响应结果
Dim strJZ As String
strJZ = Split(strNum, ",")(1)
Cells(i, 17) = strJZ
Next
End Sub
求教高手，这个怎么改？
京公网安备 11010802031449号