[發問] 請問下載融資融卷網頁 網頁元素

ashin1981

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

回復 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

GBKEE大大

感謝，已試過可以下載至sheet，請問是什麼原因造成原本的程式不能使用，是網頁程式內部有改寫嗎。

GBKEE

回復 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.     '-----------------------

複製代碼