excel vba http请求从雅虎财经下载数据
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18163560/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
excel vba http request download data from yahoo finance
提问by
I am in the process of making a program I wrote using excel vba faster.
我正在制作我使用 excel vba 编写的程序更快。
The program downloads stock market data from the asx.
该程序从 asx 下载股票市场数据。
I want to get data from 2 urls:
我想从 2 个网址获取数据：
MY CODE
我的代码
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
MY PROBLEM.
我的问题。
This file is very large. I thought I could simply store the result of these http requests and print it to the debug window or directly to a cell. However these methods seem to be cutting off parts of the data?
这个文件非常大。我想我可以简单地存储这些 http 请求的结果并将其打印到调试窗口或直接打印到单元格。然而，这些方法似乎切断了部分数据？
if I download the txt file from url 2 in notepad++ it has almost 200 000 characters but it excel it has between 3 -5 000. What is the best way to handle these requests so that all the data is captured and I can parse it all later?
如果我从记事本 ++ 中的 url 2 下载 txt 文件，它有近 200 000 个字符，但它在 3 -5 000 之间表现出色。处理这些请求的最佳方法是什么，以便捕获所有数据，我可以解析所有数据之后？
URL 2. from the first URL I only want the JSON data which results from the YQL query.
URL 2. 从第一个 URL 我只想要由 YQL 查询产生的 JSON 数据。
MY PROBLEM
我的问题
I am not sure how to get just the json data when you follow the link below, and or how to store it so that the problem experienced with URL 1 (missing data) does not occur.
当您点击下面的链接时，我不确定如何仅获取 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%20in%20%28%22bhp.ax%22%29
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%20in%20%28%22bhp.ax%22%29
Many Thanks, Josh.
非常感谢，乔希。
回答by PatricK
Try this revised code
试试这个修改后的代码
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
This will split up the data into Rows so the max text length are not reached in a cell. Also this have further split the data with commas into corresponding columns.
这会将数据拆分为行，因此单元格中不会达到最大文本长度。这也进一步用逗号将数据拆分为相应的列。
回答by Harry Duong
You may like to try following code from http://investexcel.net/importing-historical-stock-prices-from-yahoo-into-excel/
您可能想尝试以下来自http://investexcel.net/importing-historical-stock-prices-from-yahoo-into-excel/ 的代码
I just modify the qurl variable to your url and it work, it pouring 4087 line of data to my excel sheet, nicely formatted without any problem. Just name your sheet1 as Data.
我只是将 qurl 变量修改为您的 url 并且它可以工作，它将 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
(the above is not my code, it was taken from the excel file they posted on investexcel.net link above)
（以上不是我的代码，它取自他们在上面的investexcel.net链接上发布的excel文件）
