人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

ウェブ上のファイルダウンロードのマクロ作成をお願いします。もしそのまま使える完全な回答をしていただいた最初の回答者の方に、お気持ちですが1000ポイント差し上げます。よろしくお願いいたします。具体的にはこちらのサイトです。(http://isin.krx.co.kr/)ダウンロードページへは、トップメニュー(背景が青の部分です)の右から二つ目の項目の、上から4つ目のリンクです(5文字のリンク)。リンク先のページにあるフィールドにコードを打ち込み、ToExcelを押すことでエクセルファイルをダウンロードするのですが、IDがかなり多くあるため、そのプロセスを自動化したいです。Sheet1、A2以下には以下の5桁IDが入力されています。00867、00354、00680、00594、03075、00172、01636、03049、00345、03762、00856、09588、03061、10083、00120、00347、00353、01642など。是非ご協力お願いいたします。

●質問者: tororosoba
●カテゴリ:コンピュータ
✍キーワード:ウェブ エクセル コード サイト ダウンロード
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● HALSPECIAL
●1000ポイント

Option Explicit

Const DEST = "D:\保存フォルダ" '保存先のフォルダ  ■ここを変える


Public Sub XlFileDownLoad()
 Const URL_PATTERN As String = "http://isin.krx.co.kr/jsp/BA_LT133_EXCEL.jsp?pg_no=1&wr_r_cd=&ef_iss_inst_cd={0}"

 Range("A2").Activate
 
 Do Until ActiveCell.Value = ""
 Dim cd As String
 cd = ActiveCell.Value
 Dim url As String
 url = Replace(URL_PATTERN, "{0}", cd)
 Dim fname As String
 fname = DEST & "\" & cd & ".xls"
 Call DL(url, fname)
 ActiveCell.Offset(1, 0).Activate
 Loop
 
 Range("A1").Activate

 MsgBox "終了", vbInformation
 
End Sub

Private Sub DL(ByVal url As String, ByVal fname As String)
 Const adTypeBinary = 1
 Const adSaveCreateOverWrite = 2
 
 Dim xmlHttp
 Set xmlHttp = CreateObject("Msxml2.XMLHTTP")
 xmlHttp.Open "GET", url, False
 xmlHttp.Send
 
 Dim stream
 Set stream = CreateObject("Adodb.stream")
 stream.Type = adTypeBinary
 stream.Open
 stream.Write xmlHttp.responseBody
 stream.Savetofile fname, adSaveCreateOverWrite
 Set stream = Nothing
 Set xmlHttp = Nothing

End Sub

こちらでどうでしょう。

◎質問者からの返答

HALSPECIALさん、お恥ずかしい質問なのですが、標準モジュールではない場合、どこにペーストすればよろしいのでしょうか・・・ご教授いただけると助かります。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ