January 29, 2015

Excel VBAで指定したフォルダに株価データを自動でダウンロードして保存する

エクセルのワークシートに入力されたティッカーシンボルを使って、Yahoo financeから株価のデータをダウンロードして所定のフォルダにcsvとして格納するためのコードです。

制限事項:
ダウンロード先のURIは直接アクセスできるファイル名になっていること。例えば、http://hoge.com/file.csvにアクセスしたらそのままファイルのダウンロードが始まる状態であること。
そうでない場合は、IEオブジェクト等ブラウザに読み込ませて最終的なダウンロード先に転送させるようにする必要があります。

yahoo financeはurlがとても分かりやすい構造になっており、パラメータをつなげてWinHTTPでGETするだけで、データを得ることができます。なお、エラー処理等はしていませんので、所定の動作と違うこと(途中でキャンセルボタンを押すなど)をするとマクロがエラーを起こして止まります。 回収したcsvはこちらのコードを使ってブックに読み込めます。


Sub inquire_historical_data()
    Dim tickerSymbols
    Set tickerSymbols = Range(Range("A2"), Range("A1").End(xlDown))
    
    Dim csvUrl, myFile, retVal
    
    Dim Shell, myPath
    Set Shell = CreateObject("Shell.Application")
    Set myPath = Shell.BrowseForFolder(&O0, "Select folder to save files:", &H1 + &H10, "C:\")
    If Not myPath Is Nothing Then dataFolder = myPath.Items.Item.Path
    Set Shell = Nothing
    Set myPath = Nothing
    
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    For Each tickersymbol In tickerSymbols
        With tickersymbol
            csvUrl = "http://real-chart.finance.yahoo.com/table.csv?s=" + .Text _
            + "&a=" + .Offset(0, 1).Text + "&b=" + .Offset(0, 2).Text + "&c=" + .Offset(0, 3).Text _
            + "&d=" + .Offset(0, 4).Text + "&e=" + .Offset(0, 5).Text + "&f=" + .Offset(0, 6).Text + "&g=m&ignore=.csv"
        End With
        
        With http
            .Open "GET", csvUrl, False
            .Send
        End With
    
       With CreateObject("ADODB.Stream")
           .Type = 1 'adTypeBinary
           .Open
           .Write http.responseBody
           .saveToFile dataFolder + "\" + tickersymbol.Value + ".csv", 2 '1:adSaveCreateNotExist, 2:adSaveCreateOverWrite
           .Close
       End With
       
    Next
    
    MsgBox "Data download completed. Files are save to: " + dataFolder
End Sub

No comments :

Post a Comment