- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
17#
發表於 2014-8-8 09:50
| 只看該作者
本帖最後由 GBKEE 於 2014-8-8 09:51 編輯
回復 17# ciboybj
哪要先看這網頁的原始文件 [下一頁]鍵的名稱.- Sub 日報表()
- Dim D As Object, E As Object, P As Integer, URL As String, 頁數 As Integer, i As Integer
- Dim P_down As Object
- URL = "http://bsr.twse.com.tw/bshtm/"
- With CreateObject("InternetExplorer.Application")
- .Navigate URL
- .Visible = True
- Do While .readyState <> 4 Or .Busy
- DoEvents
- Loop
- Set D = .Document.all(5).all(0).contentWindow.frames.Document.getelementsbytagname("INPUT")
-
- D("txtTASKNO").Value = "1101"
- For Each E In D
- If E.Value = "查詢" Then E.Click: Exit For
- Next
- Do While .readyState <> 4 Or .Busy
- DoEvents
- Loop
- 頁數 = .Document.all(5).all(0).contentWindow.frames.Document.getElementsByName("sp_ListCount")(0).INNERTEXT
- For Each E In .Document.all(5).all(0).contentWindow.frames.Document.getelementsbytagname("INPUT")
- If E.Value = "下一頁" Then Set P_down = E: Exit For
- Next
- ActiveSheet.Cells.Clear
- .Document.Focus
- For P = 1 To 頁數
- Set D = Nothing
- Do
- DoEvents
- Set D = .Document.all(5).all(1).contentWindow.frames.Document.getelementsbytagname("table") '
-
- Loop Until Not D Is Nothing And D.Length = 7
- For i = IIf(P = 1, 3, 4) To 4
- Ep D(i).outerHTML
- Next
- P_down.Click
- Do While .readyState <> 4 Or .Busy
- DoEvents
- Loop
- Next
- .Quit
- End With
- End Sub
- Private Sub Ep(s As String) ' A(A.Length - 1).outerHTML
- With CreateObject("InternetExplorer.Application")
- .Navigate "about:Tabs"
- .Visible = True
- .Document.body.innerHTML = s
- .ExecWB 17, 2 ' Select All
- .ExecWB 12, 2 ' Copy selection
- With ActiveSheet
- ' MsgBox .UsedRange.Rows.Count
- .Range("A" & IIf(.UsedRange.Rows.Count = 1, 1, .UsedRange.Rows.Count + 1)).Select
- .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
- End With
- .Quit
- End With
- End Sub
|
|
發表於 2014-8-7 20:24
| 
