12
返回列表 上一主題 發帖

[發問] 如何用vba下載證交所網頁(日收盤價及月平均收盤價)資料

clianghot546

帖子
23 
主題
3 
精華
0 
積分
50 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
註冊時間
2014-6-24 
最後登錄
2024-4-11 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-2-3 18:09 | 只看該作者

[發問] 如何用vba下載證交所網頁(日收盤價及月平均收盤價)資料


原先可以直接用網址連結方式下載
http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY_AVG/genpage/Report201602/201602_F3_1_8_2303.php?STK_NO=2303&myear=2016&mmon=01
自2月起就無法連結
各位先進請問要如何編寫vba去下載圖片中紅色框框的資料
(證交所網址:http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY_AVG/STOCK_DAY_AVGMAIN.php)
收藏 分享

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
2#
發表於 2016-2-3 22:00 | 只看該作者
回復 1# clianghot546
試試看
  1. Sub 個股日收盤價及月平均價CSV()

  3.     Dim xml As Object
  4.     Dim stream
  5.     Dim URL As String
  6.     年 = 2016
  7.     月 = 2
  8.     股票代碼 = 1101
  9.     Set xml = CreateObject("Microsoft.XMLHTTP") '用來取得網頁資料
  10.     Set stream = CreateObject("ADODB.stream")   'ADODB.stream   '用來儲存二進位檔案
  11.     URL = "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY_AVG/STOCK_DAY_AVGMAIN.php"
  12.     xml.Open "POST", URL, 0
  13.     xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  14.     xml.send "download=csv&query_year=" & 年 & "&query_month=" & 月 & "&CO_ID=" & 股票代碼
  15.     With stream
  16.         .Open
  17.         .Type = 1
  18.         .write xml.ResponseBody
  19.         'SaveToFile:檔案名稱已存在時會有錯誤,須先刪除已存在的檔案名稱
  20.         If Dir("D:\" & 股票代碼 & ".CSV") <> "" Then Kill "D:\" & 股票代碼 & ".CSV"
  21.         .SaveToFile ("D:\" & 股票代碼 & ".CSV")
  22.         .Close
  23.     End With
  24. End Sub
複製代碼

TOP

clianghot546

帖子
23 
主題
3 
精華
0 
積分
50 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
註冊時間
2014-6-24 
最後登錄
2024-4-11 
3#
發表於 2016-2-4 09:06 | 只看該作者
回復 2# joey0415
謝謝joey0415的回覆
已試過可行
但是能否有直接類似"從web"下載後直接匯入excel儲存格的語法

TOP

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
4#
發表於 2016-2-4 15:12 | 只看該作者
回復 3# clianghot546

下載csv ，匯入再刪除即可
  1. Sub 個股日收盤價及月平均價CSV()

  3.     Dim xml As Object
  4.     Dim stream
  5.     Dim URL As String
  6.     年 = 2016
  7.     月 = 2
  8.     股票代碼 = 2498
  9.     Set xml = CreateObject("Microsoft.XMLHTTP") '用來取得網頁資料
  10.     Set stream = CreateObject("ADODB.stream")   'ADODB.stream   '用來儲存二進位檔案
  11.     URL = "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY_AVG/STOCK_DAY_AVGMAIN.php"
  12.     xml.Open "POST", URL, 0
  13.     xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  14.     xml.send "download=csv&query_year=" & 年 & "&query_month=" & 月 & "&CO_ID=" & 股票代碼
  15.     With stream
  16.         .Open
  17.         .Type = 1
  18.         .write xml.ResponseBody
  19.         'SaveToFile:檔案名稱已存在時會有錯誤,須先刪除已存在的檔案名稱
  20.         If Dir(ThisWorkbook.Path & "\" & 股票代碼 & ".CSV") <> "" Then Kill ThisWorkbook.Path & "\" & 股票代碼 & ".CSV"
  21.         .SaveToFile (ThisWorkbook.Path & "\" & 股票代碼 & ".CSV")
  22.         .Close
  23.     End With
  24.    
  25.     Cells.Clear

  27.     With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ThisWorkbook.Path & "\" & 股票代碼 & ".CSV", Destination:=Range("$A$1"))
  28.         .TextFileCommaDelimiter = True
  29.         .Refresh BackgroundQuery:=False
  30.         .Delete
  31.     End With
  32.    
  33.     Kill ThisWorkbook.Path & "\" & 股票代碼 & ".CSV"
  34.    
  35. End Sub
複製代碼

TOP

clianghot546

帖子
23 
主題
3 
精華
0 
積分
50 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
註冊時間
2014-6-24 
最後登錄
2024-4-11 
5#
發表於 2016-2-4 17:44 | 只看該作者
回復 4# joey0415
謝謝joey0415的指教
可以正常運作了

TOP

clianghot546

帖子
23 
主題
3 
精華
0 
積分
50 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
註冊時間
2014-6-24 
最後登錄
2024-4-11 
6#
發表於 2016-2-6 10:29 | 只看該作者
回復  clianghot546

下載csv ，匯入再刪除即可
joey0415 發表於 2016-2-4 15:12


再請教
原先的vba碼在WIN7+OFFICE2010可運行
在WIN10+OFFICE2016卻會卡在       .SaveToFile ("C:\Users1\CYUser\Downloads" & "\" & 股票代碼 & ".CSV")
如下圖

TOP

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
7#
發表於 2016-2-6 19:01 | 只看該作者
回復 6# clianghot546
  1. C:\Users1\CYUser\Downloads" & "\" & 股票代碼 & ".CSV")
複製代碼
我的程式碼沒有這個哦！

C:\Users1\CYUser\Downloads

路徑不對哦

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2016-2-9 13:29 | 只看該作者
回復 6# clianghot546

    WIN10+OFFICE2016卻會卡在       .SaveToFile ("C:\Users1\CYUser\Downloads" & "\" & 股票代碼 & ".CSV")

WIN10+OFFICE2016 的pc裡有這資料夾嗎?

試試看 建立資料
  1. Option Explicit
  2. Sub Ex()
  3.     Dim xPath As String, i As Integer, S As String
  4.     xPath = "C:\Users1\CYUser\Downloads"
  5.     For i = 2 To UBound(Split(xPath, "\"))
  6.         S = Mid(xPath, 1, InStr(xPath, Split(xPath, "\")(i)) - 1)
  7.         If Dir(S, vbDirectory) = "" Then MkDir S
  8.    Next
  9.    If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  10.    MsgBox Dir(xPath, vbDirectory)
  11. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

clianghot546

帖子
23 
主題
3 
精華
0 
積分
50 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
註冊時間
2014-6-24 
最後登錄
2024-4-11 
9#
發表於 2016-2-9 15:05 | 只看該作者
回復 7# joey0415
joey0415
根據您的回覆我有稍作修改以套用在我的電腦
若有冒犯請見諒

TOP

clianghot546

帖子
23 
主題
3 
精華
0 
積分
50 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
註冊時間
2014-6-24 
最後登錄
2024-4-11 
10#
發表於 2016-2-9 15:21 | 只看該作者
回復 8# GBKEE
謝謝GBKEE回覆
今日花時間從頭看一遍後發現有一處路徑未修改完全
現在可正常運作了

TOP

        靜思自在 : 太陽光大、父母恩大、君子量大，小人氣大。
12
返回列表 上一主題