麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 交易所網站的收盤價已變更?用動態查詢已失效? [打印本頁]

作者: t8899 時間: 2014-12-26 18:30 標題: 交易所網站的收盤價已變更?用動態查詢已失效?

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

作者: HSIEN6001 時間: 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

作者: t8899 時間: 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 嗎?

作者: GBKEE 時間: 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

複製代碼

作者: t8899 時間: 2014-12-27 12:17

回復 t8899

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

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

作者: tsuneng 時間: 2014-12-27 16:15

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

謝謝!

作者: t8899 時間: 2014-12-28 07:22

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

請問 GBKEE 網大:
我將.ALL("selectType").Value = "ALLBUT0999" ‘全部(不含權證、牛熊證)")
改成. ...
tsuneng 發表於 2014-12-27 16:15

改為
.BODY.innerHTML = .getElementsByTagName("table")(0).outerHTML

作者: t8899 時間: 2014-12-28 07:28

本帖最後由 t8899 於 2014-12-28 07:30 編輯

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

下面這兩行不懂
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
17,2 跟 12,2 是怎麼算的 ??

作者: GBKEE 時間: 2014-12-28 07:39

回復 8# t8899
參考一下

https://social.msdn.microsoft.com/Forums/zh-TW/cbbba9b2-4275-45b7-88e5-fb43ccb1a0e3/execwb?forum=vbgeneral

http://fengqx.iteye.com/blog/602767

作者: t8899 時間: 2014-12-28 07:45

回復 t8899
參考一下
GBKEE 發表於 2014-12-28 07:39

證券代號前面是兩個0轉入會不見 (會當成數字) 0050 ===> 50
這有無辦法修正?

作者: GBKEE 時間: 2014-12-28 08:54

回復 10# t8899

程式結束前執行Ex_副程式

Private Sub Ex_副程式()
Dim Rng As Range, r As Integer
With ActiveSheet '可指定工作表
Set Rng = .[A:A].Find("11*", LOOKAT:=xlWhole)
If Not Rng Is Nothing Then
r = 4
Do
If IsNumeric(.Cells(r, "A")) Then
.Cells(r, "A").Select
.Cells(r, "A") = "'00" & .Cells(r, "A")
End If
r = r + 1
Loop Until r = Rng.Row
End If
End With
End Sub

複製代碼

作者: t8899 時間: 2014-12-28 09:54

本帖最後由 t8899 於 2014-12-28 09:58 編輯

回復 t8899

程式結束前執行Ex_副程式
GBKEE 發表於 2014-12-28 08:54

很奇怪，如果我用 f8 單步執行 A4以後都會被會當成數字 IsNumeric(符合條件) ,前面都會加'00 ???
f5 執行是正常的

作者: GBKEE 時間: 2014-12-28 09:59

回復 12# t8899

r = r + 1
Loop Until r = Rng.Row '不會的這裡有限制啊

複製代碼

作者: tsuneng 時間: 2014-12-28 13:12

感謝指導 !!

作者: t8899 時間: 2014-12-28 14:15

順便補充2樓csv檔跟html 載入工作表的語法
CSV 檔載入
sub goDKDKD()
Dim srWk As Workbook
Dim srPth
srPth = "R:\TEMP\1.CSV"
If srPth = False Then Exit Sub
Application.ScreenUpdating = False
Set srWk = GetObject(srPth)
srWk.ActiveSheet.Cells.Copy ThisWorkbook.Worksheets(1).Cells(1)
srWk.Close False
Set srWk = Nothing
Cells(2, 1).Select
END SUB
--------------------------------------------
html 檔載入
sub goDKDKD()
Dim srWk As Workbook
Dim srPth
srPth = "R:\TEMP\1.html"
If srPth = False Then Exit Sub
Application.ScreenUpdating = False
Set srWk = Workbooks.OpenXML(srPth)
srWk.ActiveSheet.Cells.Copy ThisWorkbook.Worksheets(1).Cells(1)
srWk.Close False
Set srWk = Nothing
Cells(2, 1).Select
END SUB
---------------------------------------

作者: r2henry 時間: 2014-12-31 18:40

回復 4# GBKEE

請問如果要將您的程式碼，套用到櫃買市場，我只更改連結到
http://www.gretai.org.tw/web/stock/aftertrading/otc_quotes_no1430/stk_wn1430.php?l=zh-tw

卻出現錯誤訊息，請問哪裡還需要修改?謝謝大大

作者: chwqk 時間: 2015-1-21 23:37

才不到一個月
證交所又改了
再次失效......抓不到資料了

作者: t8899 時間: 2015-1-22 06:32

本帖最後由 t8899 於 2015-1-22 06:34 編輯

才不到一個月
證交所又改了
再次失效......抓不到資料了
chwqk 發表於 2015-1-21 23:37

將 ' .BODY.innerHTML = .getElementsByTagName("table")(?).outerHTML
改為 .BODY.innerHTML = .getElementsByTagName("table")(4).outerHTML
就可以了

作者: joey0415 時間: 2015-1-22 10:09

直接抓csv應該就行了！那個不會有table的問題

作者: chwqk 時間: 2015-1-22 15:16

工作表內A及B欄內之字元有的儲存格最後都會多一個空白
如何用VBA 刪除A、B欄所有儲存格內字元最後有空白的部份
如:
先選A欄
令其所有字元
" "=""

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