ホームページ上の複数のCSVファイルを、エクセルに自動取り込みする方法

ホームページ上のCSVファイルをダウンロードし、そのデータをエクセルに貼り付けるマクロで、1回のマクロ起動で、複数のダウンロードファイルを同ブック内で別々のシートに貼り付けていくにはどのようにすればよいのでしょうか？

以下のマクロを教えて頂き、個々のデータを取る事は分かったのですが、新たに、複数の銘柄を一回のマクロで処理する方法を考えております。

以下のマクロであれば、IBMの株価をダウンロードして終了となるところを、DELLの株価、AAPLの株価と一回のマクロで同ブック内で別のシートにデータを貼り付けをしていきたいと思っています。


Sub sample1()
Dim url As String
Dim sDate As String
Dim eDate As String
Dim Symbol As String
Dim i As Integer
sDate = "1000/1/1" '開始日
eDate = "2010/12/31" '終了日
Symbol = "IBM" '銘柄
url = "​http://ichart.finance.yahoo.com/table.csv?g=d&ig …​
url = url & "&s=" & Symbol
url = url & "&a=" & Month(sDate) - 1 & "&b=" & Day(sDate) & "&c=" & Year(sDate)
url = url & "&d=" & Month(eDate) - 1 & "&e=" & Day(eDate) & "&f=" & Year(eDate)
'データ読み込み
With ActiveSheet
.Cells.Delete
For i = 1 To .QueryTables.Count
.QueryTables(1).Delete
Next
With .QueryTables.Add(Connection:="TEXT;" & url, Destination:=.Range("A1"))
.TextFileCommaDelimiter = True
.Refresh
End With
End With
End Sub

No.1 ベストアンサー 回答者： hotosys 回答日時： 2008/10/05 10:48

例えばSheet1のA列に銘柄がある場合（A1=IBM,A2=DELL,A3=AAPL...など)、こんなのでは？

Sub sample1()
Dim ss As Worksheet
Dim ds As Worksheet
Dim url As String
Dim sDate As String
Dim eDate As String
Dim Symbol As String
Dim r As Long
Set ss = Sheets("Sheet1") 'またはActiveSheetなど銘柄があるシート
sDate = "1000/1/1" '開始日
eDate = "2010/12/31" '終了日
r = 1
Do While ss.Range("A" & r) <> ""
Symbol = ss.Range("A" & r) '銘柄
url = "http://ichart.finance.yahoo.com/table.csv?g=d&ig …
url = url & "&s=" & Symbol
url = url & "&a=" & Month(sDate) - 1 & "&b=" & Day(sDate) & "&c=" & Year(sDate)
url = url & "&d=" & Month(eDate) - 1 & "&e=" & Day(eDate) & "&f=" & Year(eDate)
'同名のシートの削除(手抜き版）
Application.DisplayAlerts = False
On Error Resume Next
Sheets(Symbol).Delete
On Error GoTo 0
Application.DisplayAlerts = True
'シートの追加とデータ読み込み
Set ds = Worksheets.Add(after:=Worksheets(Worksheets.Count))
With ds
.Name = Symbol
With .QueryTables.Add(Connection:="TEXT;" & url, Destination:=.Range("A1"))
.TextFileCommaDelimiter = True
.Refresh
End With
End With
r = r + 1
Loop
End Sub

p.s.
本当はいちいちSheet作ってquerytables.addしなくても.refreshだけでもいいかと思います。

この回答へのお礼

hotosysさん、毎回ありがとうございます。
マクロの動き、バッチリです！
とても助かりますm(__)m

お礼日時：2008/10/05 15:20