- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# ashin1981
試試看- Option Explicit
- Sub Ex()
- Dim xDate As String, hTable As Object, i As Integer, j As Integer
- xDate = "2016/01/14"
- With CreateObject("InternetExplorer.Application")
- .Visible = True
- .Navigate "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php"
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- .Document.getElementById("date-field").Value = Format(xDate, "EE/MM/DD") '填入
- '---------，(IE8 版本使用內建的fireevent 的onchange)，高於IE8版本改用調用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
- '*****Application.Wait Now + TimeValue("00:00:5") ****
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Do: DoEvents: Loop Until InStr(.Document.body.outerText, Format(xDate, "EE年MM月DD日") & Space(1) & "信用交易統計")
- '網頁已更新為查尋日期的資料
- Do
- Do
- Set hTable = .Document.getElementsByTagName("table")(3) '第4個table
- Loop Until Not hTable Is Nothing
- Loop Until hTable.Rows.Length = 5 '取得完整物件
- '********* 用迴圈 取代 Application.Wait (等候)********
- With ActiveSheet
- .UsedRange.Clear
- For i = 1 To hTable.Rows.Length - 1 '前3個是標題與空白跳過
- 'For i = 0 To hTable.Rows.Length - 1 '標題開始
- For j = 0 To hTable.Rows(i).Cells.Length - 1
- .Cells(i, j + 1) = hTable.Rows(i).Cells(j).innertext ''前3個是標題與空白跳過
- ' .Cells(i + 1, j + 1) = hTable.Rows(i).Cells(j).innertext
- Next
- Next
- End With
- .Quit
- MsgBox "OK"
- End With
- End Sub
|
|
發表於 2016-2-23 10:37
| 