Board logo

標題: [發問] 如何用vba下載證交所網頁(日收盤價及月平均收盤價)資料 [打印本頁]
作者: clianghot546    時間: 2016-2-3 18:09     標題: 如何用vba下載證交所網頁(日收盤價及月平均收盤價)資料

[attach]23243[/attach]
原先可以直接用網址連結方式下載
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    時間: 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
複製代碼
作者: clianghot546    時間: 2016-2-4 09:06

回復 2# joey0415
謝謝joey0415的回覆
已試過可行
但是能否有直接類似"從web"下載後直接匯入excel儲存格的語法
作者: joey0415    時間: 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
複製代碼
作者: clianghot546    時間: 2016-2-4 17:44

回復 4# joey0415
謝謝joey0415的指教
可以正常運作了
作者: clianghot546    時間: 2016-2-6 10:29

回復  clianghot546

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


再請教
原先的vba碼在WIN7+OFFICE2010可運行
在WIN10+OFFICE2016卻會卡在       .SaveToFile ("C:\Users1\CYUser\Downloads" & "\" & 股票代碼 & ".CSV")
如下圖
[attach]23251[/attach]
作者: joey0415    時間: 2016-2-6 19:01

回復 6# clianghot546
  1. C:\Users1\CYUser\Downloads" & "\" & 股票代碼 & ".CSV")
複製代碼
我的程式碼沒有這個哦！

C:\Users1\CYUser\Downloads

路徑不對哦
作者: GBKEE    時間: 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
複製代碼
作者: clianghot546    時間: 2016-2-9 15:05

回復 7# joey0415
joey0415
根據您的回覆我有稍作修改以套用在我的電腦
若有冒犯請見諒
作者: clianghot546    時間: 2016-2-9 15:21

回復 8# GBKEE
謝謝GBKEE回覆
今日花時間從頭看一遍後發現有一處路徑未修改完全
現在可正常運作了
作者: clianghot546    時間: 2016-2-10 09:09

回復  clianghot546


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

試試看 建立資料
GBKEE 發表於 2016-2-9 13:29

再請教一個問題
原先下載完後會產生一個連線名為"連線" ,在程式最後用
ActiveWorkbook.Connections("連線").Delete  
即可刪除
現在則會產生出"股票代號"的連線，請教可用變數的方式來處理嗎
作者: clianghot546    時間: 2016-2-10 09:13

回復 8# GBKEE


可以再請教一個問題
原先下載完後會產生一個連線名為"連線" ,在程式最後用
ActiveWorkbook.Connections("連線").Delete  
即可刪除
現在則會產生出"股票代號"的連線，請教可用變數的方式來處理嗎
作者: GBKEE    時間: 2016-2-12 13:29

回復 12# clianghot546

能力不夠,我使用2003版沒有 ActiveWorkbook.Connections
作者: clianghot546    時間: 2016-2-13 22:49

回復 13# GBKEE
tks! 先暫時用手動刪除作業



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)