返回列表 上一主題 發帖

期貨交易所鉅額股票期貨資料頡取

leoncc

帖子
15 
主題
3 
精華
0 
積分
27 
點名
0  
作業系統
Win7 
軟體版本
2010 
閱讀權限
10 
註冊時間
2013-12-23 
最後登錄
2015-8-10 
1# 跳轉到 »
發表於 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
複製代碼

TOP

leoncc

帖子
15 
主題
3 
精華
0 
積分
27 
點名
0  
作業系統
Win7 
軟體版本
2010 
閱讀權限
10 
註冊時間
2013-12-23 
最後登錄
2015-8-10 
2#
發表於 2015-5-28 17:51 | 顯示全部帖子
回復 4# GBKEE



謝謝G大回覆，但可能要再麻煩G大了，小弟執行後，無任何錯誤、但也無任何資料，檔案仍是空白。 小弟試過更改存檔路徑，但仍是空白。不勝感激

TOP

leoncc

帖子
15 
主題
3 
精華
0 
積分
27 
點名
0  
作業系統
Win7 
軟體版本
2010 
閱讀權限
10 
註冊時間
2013-12-23 
最後登錄
2015-8-10 
3#
發表於 2015-6-1 10:46 | 顯示全部帖子
回復 6# GBKEE

G大您好

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



除上述錯誤外，檔案並無任何動作，也沒有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
複製代碼

TOP

        靜思自在 : 是非當教育，讚美作警惕。
返回列表 上一主題