t8899

帖子: 760
主題: 250
精華: 0
積分: 1023
點名: 0
作業系統: windows 11
軟體版本: OFFICE2021
閱讀權限: 50
性別: 男
註冊時間: 2011-5-30
最後登錄: 2024-12-21

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2014-12-26 18:30 | 只看該作者

[發問] 交易所網站的收盤價已變更?用動態查詢已失效?

如何直接抓取匯入excel??
http://www.tse.com.tw/ch/trading/exchange/MI_INDEX/MI_INDEX.php
分類項目 ==>全部(不含權證，牛熊........)

樓主熱帖

HSIEN6001

中學生 Rank: 2

帖子: 219
主題: 24
精華: 0
積分: 243
點名: 0
作業系統: Windows10
軟體版本: Office2016
閱讀權限: 20
性別: 女
註冊時間: 2012-4-18
最後登錄: 2022-2-7

論壇榮譽勳章論壇贊助勳章

2^#

發表於 2014-12-26 21:47 | 只看該作者

回復 1# t8899

換了,用這個!

Sub XL()
Set XML = CreateObject("Microsoft.XMLHTTP")
Set stream = CreateObject("ADODB.stream")
Dim path As String, thePOSTdata, URL
path = "C:\"
日期 = "1031226"

URL = "http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/MI_INDEX.php"
thePOSTdata = "download=csv&qdate=" & 日期 & "&selectType=ALLBUT0999"
      XML.Open "POST", URL, 0
      XML.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
      XML.send thePOSTdata
With stream
      .Open
      .Type = 1
      .write XML.responseBody
      If Dir(path & "收盤" & 日期 & ".csv") <> "" Then Kill (path & "收盤" & 日期 & ".csv")
      .SaveToFile (path & "收盤" & 日期 & ".csv")
      .Close
End With

End Sub

TOP

t8899

大學生 Rank: 4

帖子: 760
主題: 250
精華: 0
積分: 1023
點名: 0
作業系統: windows 11
軟體版本: OFFICE2021
閱讀權限: 50
性別: 男
註冊時間: 2011-5-30
最後登錄: 2024-12-21

3^#

發表於 2014-12-26 22:17 | 只看該作者

回復 t8899

換了,用這個!

Sub XL()
Set XML = CreateObject("Microsoft.XMLHTTP")
Set stream = ...
HSIEN6001 發表於 2014-12-26 21:47

1.前面的大盤統計資訊可以不要嗎 ??我只要每日收盤行情(全部(不含權證、牛熊證)")"
2.您是存成csv 檔，還要再叫進來,可直接匯入 sheet1 嗎?

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2014-12-27 11:43 | 只看該作者

本帖最後由 GBKEE 於 2014-12-28 07:24 編輯

回復 3# t8899

試試看

Option Explicit
Sub Ex_盤後資訊_每日收盤行情()
Dim A As Object, xDate As Date, EDATE As Date
'***********測試用
'抓到有為止(只抓5天)，5天都抓不到也提示
EDATE = Date + 5
xDate = EDATE
'*************
'xDate = Date '正式常程式碼
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/MI_INDEX.php"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Ie_Refresh:
With .Document
.ALL("qdate").Value = Format(xDate, "E/MM/DD") '日期可修改
.ALL("selectType").Value = "MS"
.ALL("query-button").Click
End With
Do While .Busy Or .readyState <> 4: DoEvents: Loop
If InStr(.Document.BODY.innerText, "查無資料") Then
If xDate + 4 >= EDATE Then '測試用********
'If xDate + 4 >= Date Then '正式常程式碼
Debug.Print xDate '驗證用可刪除
xDate = xDate - 1
GoTo Ie_Refresh
End If
.Quit
MsgBox Format(xDate, "E/MM/DD") & " 查無資料"
Exit Sub
End If
Set A = .Document.getElementsByTagName("table")
.Document.BODY.innerHTML = A(A.Length - 1).outerHTML '取最後的一個"table"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
.Quit '關閉網頁
With ActiveSheet '可指定工作表
.UsedRange.Clear
.Range("A1").Select
.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NOHTMLFormatting:=True
End With
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

t8899

大學生 Rank: 4

帖子: 760
主題: 250
精華: 0
積分: 1023
點名: 0
作業系統: windows 11
軟體版本: OFFICE2021
閱讀權限: 50
性別: 男
註冊時間: 2011-5-30
最後登錄: 2024-12-21

5^#

發表於 2014-12-27 12:17 | 只看該作者

回復 t8899

試試看
GBKEE 發表於 2014-12-27 11:43

謝謝，可以
可否再加入
假如抓當天日期網站還沒產生(抓不到)則抓前一天.....抓到有為止(只抓5天)還抓不到就跳出
抓不到當天，則提示抓到的日期(當天不用)，5天都抓不到也提示

TOP

tsuneng

中學生 Rank: 2

帖子: 32
主題: 2
精華: 0
積分: 67
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-7-9
最後登錄: 2020-12-30

6^#

發表於 2014-12-27 16:15 | 只看該作者

請問 GBKEE 網大:
  我將.ALL("selectType").Value = "ALLBUT0999" ‘全部(不含權證、牛熊證)")
改成.ALL("selectType").Value = "MS"    '大盤統計資訊
程式跑到  .BODY.innerHTML = .getElementsByTagName("table")(1).outerHTML
出現下列訊息:
“執行階段錯誤” 91” :
沒有設定物件變數或 WITH區塊變數

謝謝!

TOP

t8899