Question

直到最近，我才使用下面的代码，这段代码运行良好。现在，突然间它不起作用。

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

这是错误消息。 “访问被拒绝。”我对此做了一些研究，我认为这与安全性有关，但我不知道最近发生了什么变化，无论是在我的机器上还是在雅虎网站上。

这是我的设置图片。

Answer 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

如何使用TR和TD标记名从Web下载数据？

1 个答案: