Question

我正在制作一个我用excel vba编写的程序。

该程序从asx下载股票市场数据。

我想从2个网址获取数据：

我的代码

url2 = "http://ichart.finance.yahoo.com/table.txt?s=bhp.ax"

Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

XMLHTTP.Open "GET", url2, False

XMLHTTP.send

result = XMLHTTP.responseText

ActiveCell.Value = result

Set XMLHTTP = Nothing

URL 1. http://ichart.finance.yahoo.com/table.txt?s=bhp.ax

我的问题。

此文件非常大。我想我可以简单地存储这些http请求的结果并将其打印到调试窗口或直接打印到单元格。然而，这些方法似乎正在切断部分数据？

如果我从记事本++中的url 2下载txt文件，它有近20万个字符但它擅长它在3 -5 000之间。处理这些请求的最佳方法是什么，以便捕获所有数据，我可以在以后解析它？

URL 2.来自第一个URL我只想要YQL查询产生的JSON数据。

我的问题

当您按照以下链接时，我不确定如何获取json数据，以及如何存储它以便不会出现URL 1（缺少数据）遇到的问题。

http://developer.yahoo.com/yql/console/?q=select%20symbol%2C%20ChangeRealtime%20from%20yahoo.finance.quotes%20where%20symbol%20in%20%28%22YHOO%22%2C%22AAPL%22%2C%22GOOG%22%2C%22MSFT%22%29%20|%20sort%28field%3D%22ChangeRealtime%22%2C%20descending%3D%22true%22%29%0A%09%09&env=http%3A%2F%2Fdatatables.org%2Falltables.env#h=select%20 *％20from％20yahoo.finance.quotes％20where％20symbol％20英寸％20％28％22bhp.ax％22％29

非常感谢，Josh。

Answer 1

尝试修改后的代码

Sub GetYahooFinanceTable()
    Dim sURL As String, sResult As String
    Dim oResult As Variant, oData As Variant, R As Long, C As Long

    sURL = "http://ichart.finance.yahoo.com/table.txt?s=bhp.ax"
    Debug.Print "URL: " & sURL
    sResult = GetHTTPResult(sURL)
    oResult = Split(sResult, vbLf)
    Debug.Print "Lines of result: " & UBound(oResult)
    For R = 0 To UBound(oResult)
        oData = Split(oResult(R), ",")
        For C = 0 To UBound(oData)
            ActiveSheet.Cells(R + 1, C + 1) = oData(C)
        Next
    Next
    Set oResult = Nothing
End Sub

Function GetHTTPResult(sURL As String) As String
    Dim XMLHTTP As Variant, sResult As String

    Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    XMLHTTP.Open "GET", sURL, False
    XMLHTTP.Send
    Debug.Print "Status: " & XMLHTTP.Status & " - " & XMLHTTP.StatusText
    sResult = XMLHTTP.ResponseText
    Debug.Print "Length of response: " & Len(sResult)
    Set XMLHTTP = Nothing
    GetHTTPResult = sResult
End Function

这会将数据拆分为行，因此单元格中未达到最大文本长度。这也进一步将数据用逗号分成相应的列。

enter image description here

Answer 2

您可以尝试使用http://investexcel.net/importing-historical-stock-prices-from-yahoo-into-excel/

中的代码

我只是将qurl变量修改为您的网址并且它可以正常工作，它将4087行数据倾注到我的Excel工作表中，格式正确，没有任何问题。只需将sheet1命名为Data。

    Sub GetData()
    Dim DataSheet As Worksheet
    Dim EndDate As Date
    Dim StartDate As Date
    Dim Symbol As String
    Dim qurl As String
    Dim nQuery As Name
    Dim LastRow As Integer

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Sheets("Data").Cells.Clear

    Set DataSheet = ActiveSheet

'        StartDate = DataSheet.Range("startDate").Value
'        EndDate = DataSheet.Range("endDate").Value
'        Symbol = DataSheet.Range("ticker").Value
'        Sheets("Data").Range("a1").CurrentRegion.ClearContents

'        qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol
'        qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
'            "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
'            Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Sheets("Data").Range("a1") & "&q=q&y=0&z=" & _
'            Symbol & "&x=.csv"


        qurl = "http://ichart.finance.yahoo.com/table.txt?s=bhp.ax"
        Debug.Print qurl

QueryQuote:
             With Sheets("Data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("Data").Range("a1"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With

            Sheets("Data").Range("a1").CurrentRegion.TextToColumns Destination:=Sheets("Data").Range("a1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=True, Space:=False, other:=False

         Sheets("Data").Columns("A:G").ColumnWidth = 12

    LastRow = Sheets("Data").UsedRange.Row - 2 + Sheets("Data").UsedRange.Rows.Count

    Sheets("Data").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets("Data").Sort
        .SetRange Range("A1:G" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        .SortFields.Clear
    End With

End Sub

（以上不是我的代码，它是从他们在上面的investexcel.net链接上发布的excel文件中获取的）

来自雅虎财经的excel vba http请求下载数据

2 个答案: