制限事項:
ダウンロード先の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