Board logo

標題: 期貨交易所鉅額股票期貨資料頡取 [打印本頁]
作者: chwqk    時間: 2014-12-6 22:33     標題: 期貨交易所鉅額股票期貨資料頡取

期貨交易所網站
http://www.taifex.com.tw/chinese/3/3_3_3.asp
契約:股票期貨
只能看
EXCEL查詢又回到
契約:台指期貨(TX)

有辦法 EXCEL VBA 頡取 契約:股票期貨 嗎??????!!!!!
請教高手們.......
作者: GBKEE    時間: 2014-12-7 07:13

回復 1# chwqk
  1. Option Explicit
  2. Sub Ex_台期_各商品成交資訊()
  3.     Dim E As Object, i As Integer, ii As Integer, K As Integer
  4.     Dim xadte As Date
  5.     xadte = DateAdd("yyyy", -1, Date)  '日期(起)：
  6.     With CreateObject("InternetExplorer.Application")
  7.         .Visible = True
  8.         .Navigate "http://www.taifex.com.tw/chinese/3/3_3_3.asp"
  9.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  10.         
  11.         '<OPTION value="TX" selected>台股期貨(TX)</OPTION>
  12.         '<OPTION value="MTX" >小型台指(MTX)</OPTION>
  13.         '<OPTION value="TXO" >台指選擇權(TXO)</OPTION>
  14.         '<OPTION value="STF" >股票期貨</OPTION>
  15.         .document.ALL("commodity_idt").Value = "STF"  '契約: 股票期貨
  16.         
  17.         With .document.getElementsByTAGName("INPUT")
  18.             .Item("datestart").Value = Format(xadte, "YYYY/MM/DD")
  19.             .Item("dateend").Value = Format(Date, "YYYY/MM/DD")
  20.             .Item("button3").Click
  21.         End With
  22.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  23.         Set E = .document.getElementsByTAGName("TABLE")(3)
  24.         ActiveSheet.UsedRange.Clear
  25.         For i = 0 To E.Rows.Length - 1
  26.             K = K + 1
  27.             For ii = 0 To E.Rows(i).Cells.Length - 1
  28.                 Cells(K, ii + 1) = E.Rows(i).Cells(ii).INNERTEXT
  29.             Next
  30.         Next
  31.         .Quit        '關閉網頁
  32.     End With
  33. End Sub
複製代碼
作者: leoncc    時間: 2015-5-24 19:13

回復 2# GBKEE

不好意思再PO一次
  1. Option Explicit
  2. Sub Ex_台期_各商品成交資訊()
  3.     Dim E As Object, i As Integer, ii As Integer, K As Integer
  4.     Dim xadte As Date
  5.     xadte = DateAdd("yyyy", -1, Date)  '日期(起)：
  6.     With CreateObject("InternetExplorer.Application")
  7.         .Visible = True
  8.         .Navigate "http://www.taifex.com.tw/chinese/3/7_12_6.asp"
  9.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  10.         
  11.         '<OPTION value="TX" selected>台股期貨(TX)</OPTION>
  12.         '<OPTION value="MTX" >小型台指(MTX)</OPTION>
  13.         '<OPTION value="TXO" >台指選擇權(TXO)</OPTION>
  14.         '<OPTION value="STF" >股票期貨</OPTION>
  15.         '.document.ALL("commodity_idt").Value = "STF"  '契約: 股票期貨
  16.         
  17.         With .document.getElementsByTAGName("INPUT")
  18.             .Item("datestart").Value = Format(xadte, "YYYY/MM/DD")
  19.             .Item("dateend").Value = Format(Date, "YYYY/MM/DD")
  20.             .Item("button4").Click
  21.         End With
  22.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  23.         Set E = .document.getElementsByTAGName("TABLE")(3)
  24.         ActiveSheet.UsedRange.Clear
  25.         For i = 0 To E.Rows.Length - 1
  26.             K = K + 1
  27.             For ii = 0 To E.Rows(i).Cells.Length - 1
  28.                 Cells(K, ii + 1) = E.Rows(i).Cells(ii).INNERTEXT
  29.             Next
  30.         Next
  31.         .Quit        '關閉網頁
  32.     End With
  33. End Sub
複製代碼
作者: GBKEE    時間: 2015-5-26 08:17

回復 3# leoncc
這網頁是要下載檔案
  1. Option Explicit
  2. Sub Ex_台期_各商品成交資訊()
  3.     Dim xDate(1 To 2) As Date, xPath As String, wB As String
  4.     'IE 下載檔案的資料夾
  5.     xPath = "C:\Documents and Settings\hsu\My Documents\"
  6.     '清空 下載檔案的資料夾 的csv檔
  7.     If Dir(xPath & "*.csv") <> "" Then Kill xPath & "*.csv"
  8.    
  9.     xDate(1) = DateAdd("yyyy", -1, Date)        '日期(起)：
  10.     xDate(2) = Date                             '日期(迄)：
  11.     If Weekday(Date, vbMonday) >= 6 Then        '當日非營業日
  12.         Do While Weekday(Date, vbMonday) >= 6
  13.             xDate(2) = xDate(2) - 1
  14.         Loop
  15.     ElseIf Time < #3:00:00 PM# Then
  16.         xDate(2) = xDate(2) - 1                 '當日大盤資料尚未整理完畢
  17.     End If
  18.    
  19.     With CreateObject("InternetExplorer.Application")
  20.         .Visible = True
  21.         .Navigate "http://www.taifex.com.tw/chinese/3/7_12_6.asp"
  22.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  23.         
  24.         '<OPTION value="TX" selected>台股期貨(TX)</OPTION>
  25.         '<OPTION value="MTX" >小型台指(MTX)</OPTION>
  26.         '<OPTION value="TXO" >台指選擇權(TXO)</OPTION>
  27.         '<OPTION value="STF" >股票期貨</OPTION>
  28.         '.document.ALL("commodity_idt").Value = "STF"  '契約: 股票期貨
  29.         
  30.         With .document.getElementsByTAGName("INPUT")
  31.             .Item("datestart").Value = Format(xDate(1), "YYYY/MM/DD")
  32.             .Item("dateend").Value = Format(xDate(2), "YYYY/MM/DD")
  33.             .Item("button4").Click
  34.         End With
  35.           Application.Wait Now + #12:00:02 AM#
  36.           Application.SendKeys "%s", True
  37.           Application.Wait Now + #12:00:01 AM#  '如VBA執行速度快,可延長秒數
  38.           Application.SendKeys "%s", True
  39.         .Quit        '關閉網頁
  40.     End With
  41.      wB = Dir(xPath & "*.csv")
  42.      If wB <> "" Then Workbooks.Open (xPath & wB) '開啟下載的檔案
  43. End Sub
複製代碼
作者: leoncc    時間: 2015-5-28 17:51

回復 4# GBKEE



謝謝G大回覆，但可能要再麻煩G大了，小弟執行後，無任何錯誤、但也無任何資料，檔案仍是空白。 小弟試過更改存檔路徑，但仍是空白。不勝感激
作者: GBKEE    時間: 2015-5-29 09:33

回復 5# leoncc

IE8下載檔案資料夾, 須是前一次下載檔案資料夾
如圖
[attach]21059[/attach]

IE8  如不這選項不勾選

[attach]21060[/attach]

可直接開啟檔案(IE8 以上的IE 也可以試看看
  1. With .document.getElementsByTAGName("INPUT")
  2.             .Item("datestart").Value = Format(xDate(1), "YYYY/MM/DD")
  3.             .Item("dateend").Value = Format(xDate(2), "YYYY/MM/DD")
  4.             .Item("button4").Click
  5.         End With
  6.           Application.Wait Now + #12:00:02 AM#
  7.           Application.SendKeys "%s", True       '儲存
  8.           Application.Wait Now + #12:00:02 AM#  '如VBA執行速度快,可延長秒數
  9.           Application.SendKeys "%s", True       '另存新檔
  10.           Application.Wait Now + #12:00:02 AM#
  11.           Application.SendKeys "%O", True       ' ***開啟檔案***
  12.         .Quit        '關閉網頁
複製代碼
這段程式碼可刪除
  1.   xPath = "C:\Documents and Settings\hsu\My Documents\"
  2.    If Dir(xPath & "*.csv") <> "" Then Kill xPath & "*.csv"
  3. '*************
  4. wB = Dir(xPath & "*.csv")
  5.    If wB <> "" Then Workbooks.Open (xPath & wB) '開啟下載的檔案
複製代碼
作者: leoncc    時間: 2015-6-1 10:46

回復 6# GBKEE

G大您好

早上10:40測試了一下，還是出現下列錯誤:

[attach]21074[/attach]

除上述錯誤外，檔案並無任何動作，也沒有G大所述下載檔案的視窗。
另外跟G大報告，我的是IE11，要再麻煩G大了 不好意思

原始碼:
  1. Option Explicit
  2. Sub Ex_台期_各商品成交資訊()
  3.     Dim xDate(1 To 2) As Date, xPath As String, wB As String
  4.     'IE 下載檔案的資料夾
  5.    ' xPath = "C:\Documents and Settings\hsu\My Documents\"
  6.     '清空 下載檔案的資料夾 的csv檔
  7.     'If Dir(xPath & "*.csv") <> "" Then Kill xPath & "*.csv"
  8.    
  9.     xDate(1) = DateAdd("yyyy", -1, Date)        '日期(起)：
  10.     xDate(2) = Date                             '日期(迄)：
  11.     If Weekday(Date, vbMonday) >= 6 Then        '當日非營業日
  12.         Do While Weekday(Date, vbMonday) >= 6
  13.             xDate(2) = xDate(2) - 1
  14.         Loop
  15.     ElseIf Time < #3:00:00 PM# Then
  16.         xDate(2) = xDate(2) - 1                 '當日大盤資料尚未整理完畢
  17.     End If
  18.    
  19.     With CreateObject("InternetExplorer.Application")
  20.         .Visible = True
  21.         .Navigate "http://www.taifex.com.tw/chinese/3/7_12_6.asp"
  22.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  23.         
  24.         '<OPTION value="TX" selected>台股期貨(TX)</OPTION>
  25.         '<OPTION value="MTX" >小型台指(MTX)</OPTION>
  26.         '<OPTION value="TXO" >台指選擇權(TXO)</OPTION>
  27.         '<OPTION value="STF" >股票期貨</OPTION>
  28.         '.document.ALL("commodity_idt").Value = "STF"  '契約: 股票期貨
  29.         
  30.         With .document.getElementsByTAGName("INPUT")
  31.             .Item("datestart").Value = Format(xDate(1), "YYYY/MM/DD")
  32.             .Item("dateend").Value = Format(xDate(2), "YYYY/MM/DD")
  33.             .Item("button4").Click
  34.         End With
  35.           Application.Wait Now + #12:00:02 AM#
  36.           Application.SendKeys "%s", True       '儲存
  37.           Application.Wait Now + #12:00:02 AM#  '如VBA執行速度快,可延長秒數
  38.           Application.SendKeys "%s", True       '另存新檔
  39.           Application.Wait Now + #12:00:02 AM#
  40.           Application.SendKeys "%O", True       ' ***開啟檔案***
  41.         .Quit        '關閉網頁

  43.     End With
  44.     ' wB = Dir(xPath & "*.csv")
  45.      'If wB <> "" Then Workbooks.Open (xPath & wB) '開啟下載的檔案
  46. End Sub
複製代碼
作者: GBKEE    時間: 2015-6-1 14:09

本帖最後由 GBKEE 於 2015-6-1 14:10 編輯

回復 7# leoncc
再試試看
  1. Option Explicit
  2. Sub Ex_台期_各商品成交資訊()
  3.     Dim xDate(1 To 2) As Date, xPath As String, wB As String
  4.     xDate(1) = DateAdd("yyyy", -1, Date)        '日期(起)：
  5.     xDate(2) = Date                             '日期(迄)：
  6.     If Time < #3:00:00 PM# Then                  '營時間業結束之前待大盤資料整理完畢
  7.         Do While Weekday(xDate(2), vbMonday) >= 6 Or Weekday(xDate(2), vbMonday) = 1
  8.             '排除 週六,週日,週一
  9.             xDate(2) = xDate(2) - 1   '向前減一日
  10.         Loop
  11.     ElseIf Time < #3:00:00 PM# Then     ''當日大盤資料整理完畢
  12.         Do While Weekday(xDate(2), vbMonday) >= 6 '排除 週六,週日
  13.             xDate(2) = xDate(2) - 1   '向前減一日
  14.         Loop
  15.     End If
  16.     With CreateObject("InternetExplorer.Application")
  17.         .Visible = True
  18.         .Navigate "http://www.taifex.com.tw/chinese/3/7_12_6.asp"
  19.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  20.         
  21.         '<OPTION value="TX" selected>台股期貨(TX)</OPTION>
  22.         '<OPTION value="MTX" >小型台指(MTX)</OPTION>
  23.         '<OPTION value="TXO" >台指選擇權(TXO)</OPTION>
  24.         '<OPTION value="STF" >股票期貨</OPTION>
  25.         '.document.ALL("commodity_idt").Value = "STF"  '契約: 股票期貨
  26.         
  27.         With .Document.getElementsByTAGName("INPUT")
  28.             .Item("datestart").Value = Format(xDate(1), "YYYY/MM/DD")
  29.             .Item("dateend").Value = Format(xDate(2), "YYYY/MM/DD")
  30.             .Item("button4").Click
  31.         End With
  32.           Application.Wait Now + #12:00:02 AM#
  33.           Application.SendKeys "%s", True       '儲存
  34.           Application.Wait Now + #12:00:02 AM#  '如VBA執行速度快,可延長秒數
  35.           Application.SendKeys "%s", True       '另存新檔
  36.           Application.Wait Now + #12:00:02 AM#
  37.           Application.SendKeys "%O", True       ' ***開啟檔案***
  38.         .Quit        '關閉網頁
  39.     End With
  40.   
  41. End Sub
複製代碼




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