excel vba http request download data from yahoo finance

后端 未结 2 1343
既然无缘
既然无缘 2020-12-10 20:42

I am in the process of making a program I wrote using excel vba faster.

The program downloads stock market data from the asx.

I want to get data from 2 urls:

相关标签:
2条回答
  • 2020-12-10 20:58

    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.

    enter image description here

    0 讨论(0)
  • 2020-12-10 21:08

    You may like to try following code from 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.

        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)

    0 讨论(0)
提交回复
热议问题