求助EXCEL 获取贵金属数据不好使了,请问哪里的问题?

Sub 获取工行贵金属()
Dim sTemp As String
Dim startindex As Long

url = "http://www.icbc.com.cn/ICBCDynamicSite/Charts/GoldTendencyPicture.aspx"
With CreateObject("Microsoft.XMLHTTP")
.Open "GET", url, False, "", ""
.setRequestHeader "If-Modified-Since", "0"
.Send
sTemp = .responseText
End With

startindex = InStr(10, sTemp, "人民币账户白银")
endindex = InStr(startindex, sTemp, "交易")
substr = Mid(sTemp, startindex + 200, endindex - startindex + 1)
substr = Split(substr, "</td>")(3)
icbcag = CDbl(Trim(Split(substr, ">")(1)))

startindex = InStr(10, sTemp, "人民币账户黄金")
endindex = InStr(startindex, sTemp, "交易")
substr = Mid(sTemp, startindex + 200, endindex - startindex + 1)
substr = Split(substr, "</td>")(3)
icbcau = CDbl(Trim(Split(substr, ">")(1)))

startindex = InStr(10, sTemp, "美元账户黄金")
endindex = InStr(startindex, sTemp, "交易")
substr = Mid(sTemp, startindex + 200, endindex - startindex + 1)
substr = Split(substr, "</td>")(3)
icbcau_usd = CDbl(Trim(Split(substr, ">")(1)))

startindex = InStr(10, sTemp, "美元账户白银")
endindex = InStr(startindex, sTemp, "交易")
substr = Mid(sTemp, startindex + 200, endindex - startindex + 1)
substr = Split(substr, "</td>")(3)
icbcag_usd = CDbl(Trim(Split(substr, ">")(1)))

startindex = InStr(10, sTemp, " Ag(T+D)")
endindex = InStr(startindex, sTemp, "交易")
substr = Mid(sTemp, startindex + 200, endindex - startindex + 1)
substr = Split(substr, "</td>")(0)
agtd = CDbl(Trim(substr))

startindex = InStr(10, sTemp, " Au(T+D)")
endindex = InStr(startindex, sTemp, "交易")
substr = Mid(sTemp, startindex + 200, endindex - startindex + 1)
substr = Split(substr, "</td>")(0)
autd = CDbl(Trim(substr))

startindex = InStr(10, sTemp, " Au99.99")
endindex = InStr(startindex, sTemp, "交易")
substr = Mid(sTemp, startindex + 200, endindex - startindex + 1)
substr = Split(substr, "</td>")(0)
au9999 = CDbl(Trim(substr))

Sheet6.Range("B2") = icbcag
Sheet6.Range("B3") = icbcau
Sheet6.Range("B4") = icbcag_usd
Sheet6.Range("B5") = icbcau_usd
Sheet6.Range("B6") = agtd
Sheet6.Range("B7") = autd
Sheet6.Range("B8") = au9999

End Sub
这个以前是好使的,现在不知道怎么不好使了。
发表时间 2023-02-24 23:54     来自河南

赞同来自: ptly

0

路履薄冰

赞同来自:

@perl2006
Rem With CreateObject("Microsoft.XMLHTTP")
With CreateObject("MSXML2.ServerXMLHTTP.6.0")

试试
感谢分享,可以使用了
2023-03-04 08:39 来自浙江 引用

要回复问题请先登录注册

发起人

问题状态

  • 最新活动: 2023-03-04 08:39
  • 浏览: 1394
  • 关注: 3