雅虎的股票财务报表不再转换为excel

我有一个VBA代码，可以将股票财务报表（损益表、资产负债表、现金流量）从yahoo finance传输到excel，我已经用了一段时间了，但看起来yahoo已经改变了链接或其他内容。有人能帮我重新链接链接，这样编码就可以将从yahoo提取的信息再次传输到excel吗？下面是代码

次级财务报表（） 作为字符串的Dim-ticker 以字符串结尾

Application.ScreenUpdating = False


ticker = Sheets("inputs").Cells(2, 1)
If Sheets("Inputs").Shapes("Check Box 14").ControlFormat.Value = 1 Then
    urlend = "&annual"
Else: urlend = ""

End If



Sheets("Income Statement").Select
Cells.Clear

If Sheets("Inputs").Shapes("Check Box 11").ControlFormat.Value = 1 Then

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://finance.yahoo.com/q/is?s=" & ticker & "" & urlend & "", Destination:=Range("$A$1") _
)
.Name = "is?s=MSFT&annual"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "9"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
  End With

      End If


    Sheets("Balance Sheet").Select
Cells.Clear

If Sheets("Inputs").Shapes("Check Box 12").ControlFormat.Value = 1 Then

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://finance.yahoo.com/q/bs?s=" & ticker & "" & urlend & "", Destination:=Range("$A$1") _
)
.Name = "is?s=MSFT&annual"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "9"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
    End With
       End If

Sheets("Cash Flows").Select
Cells.Clear
If Sheets("Inputs").Shapes("Check Box 13").ControlFormat.Value = 1 Then

'
     With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://finance.yahoo.com/q/cf?s=" & ticker & "" & urlend & "", Destination:=Range("$A$1") _
)
.Name = "is?s=MSFT&annual"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "9"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
    End With
End If


Application.ScreenUpdating = True

End Sub

---

我认为雅虎最近改变了它的网站。只需检查你的URL，并首先让它工作

当你知道这是正确的，你就可以围绕这一点设计其他一切

这里有一个适合我的解决方案。这将导入表格中列出的多个标记的数据，在单元格A2中，一直导入到数组的末尾

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")
    ' http://finance.yahoo.com/quote/" & Symbol & "/financials?ltr=1
    xmlHttp.Open "GET", "http://finance.yahoo.com/quote/" & Symbol & "/financials?ltr=1", 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

这是我的设置的屏幕截图

---

您可能想询问雅虎，或者查看他们的文档？我理解，但我不完全确定如何有效地更正。我不是编写代码的人我想我的问题应该是如何得到，或者确切的API地址是什么？看起来它现在是动态生成的。看起来损益表、资产负债表和现金流量表都有表class=Lh（1.7）W（100%）M（0）Yahoo最近一定更改了它。好吧，我为我的无知道歉，所以这意味着它无法修复，我应该寻找其他来源？