直到最近,我才使用下面的代码,这段代码运行良好。现在,突然间它不起作用。
Sub Dow_HistoricalData()
Dim xmlHttp As Object
Dim TR_col As Object, TR As Object
Dim TD_col As Object, TD As Object
Dim row As Long, col As Long
ThisSheet = ActiveSheet.Name
Range("A2").Select
Do Until ActiveCell.Value = ""
Symbol = ActiveCell.Value
Sheets(ThisSheet).Select
Sheets.Add
Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
myURL = "http://finance.yahoo.com/quote/" & Symbol & "/financials?ltr=1"
xmlHttp.Open "GET", myURL, False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
Dim html As Object
Set html = CreateObject("htmlfile")
html.body.innerHTML = xmlHttp.responseText
Dim tbl As Object
Set tbl = html.getElementById("Lh(1.7) W(100%) M(0)")
'
row = 1
col = 1
Set TR_col = html.getElementsByTagName("TR")
For Each TR In TR_col
Set TD_col = TR.getElementsByTagName("TD")
For Each TD In TD_col
Cells(row, col) = TD.innerText
col = col + 1
Next
col = 1
row = row + 1
Next
Sheets(ActiveSheet.Name).Name = Symbol
Sheets(ThisSheet).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
我收到此行中的错误消息: xmlHttp.send
这是错误消息。 “访问被拒绝。”我对此做了一些研究,我认为这与安全性有关,但我不知道最近发生了什么变化,无论是在我的机器上还是在雅虎网站上。
这是我的设置图片。
答案 0 :(得分:1)
我认为URL已从http移至https,因此出现此错误。另外,我更改为CreateObject("MSXML2.ServerXMLHTTP")
Sub Dow_HistoricalData()
Dim xmlHttp As Object, html As Object
Dim tbl As Object
Dim TR_col As Object, TR As Object
Dim TD_col As Object, TD As Object
Dim row As Long, col As Long, i As Long
Dim sht As Worksheet, newSht As Worksheet
Set sht = ActiveSheet
i = 2
Do Until sht.Cells(i, 1) = ""
Set newSht = Sheets.Add
Symbol = sht.Cells(i, 1)
newSht.Name = Symbol
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
myURL = "https://finance.yahoo.com/quote/" & Symbol & "/financials?ltr=1"
xmlHttp.Open "GET", myURL, False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
Set html = CreateObject("htmlfile")
html.body.innerHTML = xmlHttp.responseText
Set tbl = html.getElementById("Lh(1.7) W(100%) M(0)")
'
row = 1
col = 1
Set TR_col = html.getElementsByTagName("TR")
For Each TR In TR_col
Set TD_col = TR.getElementsByTagName("TD")
For Each TD In TD_col
newSht.Cells(row, col) = TD.innerText
col = col + 1
Next
col = 1
row = row + 1
Next
i = i + 1
Loop
Set TR_col = Nothing
Set TR = Nothing
Set TD = Nothing
Set html = Nothing
Set xmlHttp = Nothing
End Sub