暱稱: joey0415
中學生
- 帖子
- 361
- 主題
- 57
- 精華
- 0
- 積分
- 426
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- 2003,2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2010-5-13
- 最後登錄
- 2022-12-8
|
回復 3# clianghot546
下載csv ,匯入再刪除即可- Sub 個股日收盤價及月平均價CSV()
- Dim xml As Object
- Dim stream
- Dim URL As String
- 年 = 2016
- 月 = 2
- 股票代碼 = 2498
- Set xml = CreateObject("Microsoft.XMLHTTP") '用來取得網頁資料
- Set stream = CreateObject("ADODB.stream") 'ADODB.stream '用來儲存二進位檔案
- URL = "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY_AVG/STOCK_DAY_AVGMAIN.php"
- xml.Open "POST", URL, 0
- xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- xml.send "download=csv&query_year=" & 年 & "&query_month=" & 月 & "&CO_ID=" & 股票代碼
- With stream
- .Open
- .Type = 1
- .write xml.ResponseBody
- 'SaveToFile:檔案名稱已存在時會有錯誤,須先刪除已存在的檔案名稱
- If Dir(ThisWorkbook.Path & "\" & 股票代碼 & ".CSV") <> "" Then Kill ThisWorkbook.Path & "\" & 股票代碼 & ".CSV"
- .SaveToFile (ThisWorkbook.Path & "\" & 股票代碼 & ".CSV")
- .Close
- End With
-
- Cells.Clear
- With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ThisWorkbook.Path & "\" & 股票代碼 & ".CSV", Destination:=Range("$A$1"))
- .TextFileCommaDelimiter = True
- .Refresh BackgroundQuery:=False
- .Delete
- End With
-
- Kill ThisWorkbook.Path & "\" & 股票代碼 & ".CSV"
-
- End Sub
複製代碼 |
|