Board logo

標題: [發問] 請問下載融資融卷網頁 [打印本頁]
作者: ashin1981    時間: 2016-2-22 22:12     標題: 請問下載融資融卷網頁

本帖最後由 GBKEE 於 2016-2-23 10:38 編輯

GBKEE、joey0415及各位大大你好

想請教你，我目前在試下載個股每日的融資融卷網頁http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php，爬文時有看到這個joey0415大大撰寫的(http://forum.twbts.com/viewthrea ... a=pageD1&page=2)的程式碼ex()函式，但是試著去執行時，執行到   Set evt = .Document.createEvent("HTMLEvents") 時，就出現物件不支援此屬性與方法錯誤，不曉得
joey0415、GBKEE大大可以幫忙協助嗎

Sub ex()

    With CreateObject("internetexplorer.application")
        .Visible = True
        .Navigate "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        
        .Document.getElementById("date-field").Value = "104/08/12" '填入
         
        '---------，內建的fireevent 的onchange失效，改用調用js的方法--------
        Set evt = .Document.createEvent("HTMLEvents")
        evt.initEvent "change", True, False
        Set lst = .Document.all("selectType") 'option的name是selectType，但getElementsByName無法處理，要all才行
        lst.selectedIndex = 0
        lst.dispatchEvent evt
   
        .Document.all("query-button").Click


         Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop

        Application.Wait Now + TimeValue("00:00:5")
'        Stop
        
'        For Z = 0 To 10
'        MsgBox .Document.getElementsByTagName("table")(Z).innerText
'        Next
            Stop
        Set hTable = .Document.getElementsByTagName("table")(3) '第4個table
'        tt = hTable.Rows.Length
'        qq = hTable.Rows(2).Cells.Length

            With ActiveSheet
                For i = 1 To hTable.Rows.Length - 1 '前3個是標題與空白跳過
                    For j = 0 To hTable.Rows(i).Cells.Length - 1
                        .Cells(i, j + 1) = hTable.Rows(i).Cells(j).innerText
                    Next
                Next
            End With

        .Quit
'        MsgBox "OK"
    End With
   
End Sub
作者: GBKEE    時間: 2016-2-23 10:37

回復 1# ashin1981
試試看
  1. Option Explicit
  2. Sub Ex()
  3.         Dim xDate As String, hTable As Object, i As Integer, j As Integer
  4.         xDate = "2016/01/14"
  5.         With CreateObject("InternetExplorer.Application")
  6.             .Visible = True
  7.             .Navigate "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php"
  8.             Do While .Busy Or .readyState <> 4: DoEvents: Loop
  9.             .Document.getElementById("date-field").Value = Format(xDate, "EE/MM/DD") '填入
  10.             '---------，(IE8 版本使用內建的fireevent 的onchange)，高於IE8版本改用調用js的方法--------
  11.             '   Set evt = .Document.createEvent("HTMLEvents")
  12.             '   evt.initEvent "change", True, False
  13.             ' Set lst = .Document.all("selectType") 'option的name是selectType，但getElementsByName無法處理，要all才行
  14.             '   lst.selectedIndex = 0
  15.             '   lst.dispatchEvent evt
  16.             .Document.all("query-button").Click
  17.             '*****Application.Wait Now + TimeValue("00:00:5") ****
  18.             Do While .Busy Or .readyState <> 4: DoEvents: Loop
  19.             Do:    DoEvents:     Loop Until InStr(.Document.body.outerText, Format(xDate, "EE年MM月DD日") & Space(1) & "信用交易統計")
  20.             '網頁已更新為查尋日期的資料
  21.             Do
  22.                 Do
  23.                     Set hTable = .Document.getElementsByTagName("table")(3) '第4個table
  24.                 Loop Until Not hTable Is Nothing
  25.             Loop Until hTable.Rows.Length = 5  '取得完整物件
  26.             '*********    用迴圈 取代  Application.Wait (等候)********
  27.             With ActiveSheet
  28.                 .UsedRange.Clear
  29.                 For i = 1 To hTable.Rows.Length - 1 '前3個是標題與空白跳過
  30.                 'For i = 0 To hTable.Rows.Length - 1 '標題開始
  31.                     For j = 0 To hTable.Rows(i).Cells.Length - 1
  32.                         .Cells(i, j + 1) = hTable.Rows(i).Cells(j).innertext  ''前3個是標題與空白跳過
  33.                        ' .Cells(i + 1, j + 1) = hTable.Rows(i).Cells(j).innertext
  34.                     Next
  35.                 Next
  36.             End With
  37.             .Quit
  38.             MsgBox "OK"
  39.     End With
  40. End Sub
複製代碼
作者: ashin1981    時間: 2016-2-25 19:34

GBKEE大大

感謝，已試過可以下載至sheet，請問是什麼原因造成原本的程式不能使用，是網頁程式內部有改寫嗎。
作者: GBKEE    時間: 2016-2-25 21:29

回復 3# ashin1981

'---------這段程式碼需用在高於IE8版本,IE8版不適用這段程式碼 --------
  1.     Set evt = .Document.createEvent("HTMLEvents")
  2.     evt.initEvent "change", True, False
  3.     Set lst = .Document.all("selectType") 'option的name是selectType，但getElementsByName無法處理，要all才行
  4.     lst.selectedIndex = 0
  5.     lst.dispatchEvent evt
  6.     '-----------------------
複製代碼




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