2013-08-10 6 views
3

Я нахожусь в процессе создания программы, которую я написал, используя excel vba быстрее.excel vba http request скачать данные от yahoo finance

Программа загружает данные фондового рынка из asx.

Я хочу, чтобы получить данные от 2 URLs:

МОЕГО КОДА

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-запросов и распечатать его в окне отладки или непосредственно в ячейке. Однако эти методы, похоже, отсекают части данных?

Если я загружаю txt-файл с url 2 в блокноте ++, он имеет почти 200 000 символов , но он превосходит его от 3 до 5 000. Каким образом можно обрабатывать эти запросы, чтобы все данные были захвачены и Я могу разобрать все это позже?

URL 2. из первого URL-адреса Мне нужны только данные JSON, которые являются результатом запроса YQL.

МОЯ ПРОБЛЕМА

Я не уверен, как получить только данные 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

Большое спасибо, Джош.

+0

Спасибо Я получил код для работы, здорово! Я получил код для работы, изменив следующее: для R = 0 для UBound (oArray) AND oArray = Split (sResult, vbLf) –

ответ

3

Попробуйте этот пересмотренный код

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

+0

Проблема перед разделяющей частью. То есть, если вы загружаете документ вручную, то в этом файле содержится больше данных (количество символов равно 200k) по сравнению с переменной sResult, которая хранит = XMLHTTP.ResponseText. (где количество символов как 18k) Любые идеи? –

+0

Я только что протестировал код и загрузил из Chrome, длина такая же (188066 в момент этого комментария, в 3927 строк). – PatricK

+0

Как вы проверили код? Я не могу заставить эту линию работать? oData = Split (oResult (R), ",") –

0

Вы можете попробовать следующий код из http://investexcel.net/importing-historical-stock-prices-from-yahoo-into-excel/

Я просто изменить переменную QUrl в свой адрес, и она работает, она заливке 4087 строку данных в моем первенствовать лист, красиво отформатирована без каких-либо проблема. Просто укажите ваш лист1 как данные.

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 ссылку выше)