返回列表 上一主題 發帖

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

回復 1# clianghot546
試試看
  1. Sub 個股日收盤價及月平均價CSV()

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

TOP

回復 3# clianghot546

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

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

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

TOP

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

C:\Users1\CYUser\Downloads

路徑不對哦

TOP

        靜思自在 : 稻穗結得越飽滿,越會往下垂,一個人越有成就,就要越有謙沖的胸襟。
返回列表 上一主題