返回列表 上一主題 發帖

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

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

回復 3# t8899

試試看
  1. Option Explicit
  2. Sub Ex_盤後資訊_每日收盤行情()
  3.     Dim A As Object, xDate As Date, EDATE As Date
  4.     '***********測試用
  5.     '抓到有為止(只抓5天),5天都抓不到也提示
  6.     EDATE = Date + 5
  7.     xDate = EDATE
  8.     '*************
  9.     'xDate = Date    '正式常程式碼
  10.     With CreateObject("InternetExplorer.Application")
  11.         .Visible = True
  12.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/MI_INDEX.php"
  13.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  14. Ie_Refresh:
  15.         With .Document
  16.             .ALL("qdate").Value = Format(xDate, "E/MM/DD") '日期可修改
  17.             .ALL("selectType").Value = "MS"
  18.             .ALL("query-button").Click
  19.         End With
  20.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  21.         If InStr(.Document.BODY.innerText, "查無資料") Then
  22.             If xDate + 4 >= EDATE Then  '測試用********
  23.             'If xDate + 4 >= Date Then   '正式常程式碼
  24.                 Debug.Print xDate       '驗證用 可刪除
  25.                 xDate = xDate - 1
  26.                 GoTo Ie_Refresh
  27.             End If
  28.              .Quit
  29.             MsgBox Format(xDate, "E/MM/DD") & " 查無資料"
  30.             Exit Sub
  31.            
  32.         End If
  33.         Set A = .Document.getElementsByTagName("table")
  34.         .Document.BODY.innerHTML = A(A.Length - 1).outerHTML '取最後的一個"table"
  35.         
  36.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  37.         .ExecWB 17, 2       '  Select All
  38.         .ExecWB 12, 2       '  Copy selection
  39.         .Quit        '關閉網頁
  40.          With ActiveSheet    '可指定工作表
  41.             .UsedRange.Clear
  42.             .Range("A1").Select
  43.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NOHTMLFormatting:=True
  44.         End With
  45.            End With
  46. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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

TOP

回復 10# t8899

程式結束前 執行Ex_副程式
  1. Private Sub Ex_副程式()
  2.     Dim Rng As Range, r As Integer
  3.     With ActiveSheet    '可指定工作表
  4.         Set Rng = .[A:A].Find("11*", LOOKAT:=xlWhole)
  5.         If Not Rng Is Nothing Then
  6.             r = 4
  7.             Do
  8.                 If IsNumeric(.Cells(r, "A")) Then
  9.                     .Cells(r, "A").Select
  10.                     .Cells(r, "A") = "'00" & .Cells(r, "A")
  11.                 End If
  12.                 r = r + 1
  13.             Loop Until r = Rng.Row
  14.         End If
  15.     End With
  16. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 12# t8899
  1.         r = r + 1
  2.             Loop Until r = Rng.Row  '不會的這裡有限制啊
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 生氣,就是拿別人的過錯來懲罰自己。
返回列表 上一主題