- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2015-9-9 10:38
| 只看該作者
回復 1# justintoolbox
試試看- Option Explicit
- Sub 網頁_contentWindow()
- Dim my_url As String, xDate As String, E As Object, b As Object, i As Integer, R As Integer
- my_url = "http://mops.twse.com.tw/server-java/t13sa150_otc?step=0"
- With CreateObject("InternetExplorer.Application")
- ' .Visible = True
- .Navigate my_url
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Set E = .Document.ALL(4).contentWindow.Document '這網頁輸入元素在這裡
- Set b = E.getElementsByTagName("SELECT")
- my_url = ""
- For i = 1 To b("bcode").Length
- my_url = my_url & " " & i & b("bcode")(i - 1).innerText & vbLf
- '讀取分類項目的內容
- Next
-
- Do
- i = Val(InputBox(my_url, , 1)) '分類項目的選擇
- If i = 0 Then
- If MsgBox("分類項目 沒有選擇" & vbLf & "離開 程式?", vbYesNo) = vbYes Then
- GoTo Exx
- End If
- End If
- Loop Until i > 0 And i <= b("bcode").Length
- Do
- xDate = Application.InputBox(Date, "請輸入日期", Date) '資料日期 輸入
- If Not IsDate(xDate) Then
- If MsgBox("資料日期 輸入錯誤" & vbLf & "離開 程式?", vbYesNo) = vbYes Then
- GoTo Exx
- End If
- End If
- Loop Until IsDate(xDate)
- xDate = CDate(xDate) '轉為日期型態
- b("bcode").selectedIndex = i - 1 '分類項目
- b("years").selectedIndex = Year(Date) - Year(xDate) '年度
- b("months").selectedIndex = Month(xDate) - 1 '月份
- b("days").selectedIndex = Day(xDate) - 1 '日期
- For Each b In E.getElementsByTagName("INPUT")
- If b.Type = "submit" Then b.Click
- Next
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- '**** 作法1
- ' Set E = .Document.ALL(5).contentWindow.Document '這網頁查詢資料在這裡
- 'Set E = E.getElementsByTagName("table")(0)
- 'Ep E.outerHTML '網頁資料文字
- '******************
- '**** 作法2
- Set E = .Document.ALL(5).contentWindow.Document '這網頁查詢資料在這裡
- Set E = E.getElementsByTagName("table")(0).Rows
- With Sheets(2)
- .UsedRange.Clear
- For Each b In E
- For i = 0 To b.Cells.Length - 1
- .Cells(R + 1, i + 1) = b.Cells(i).innerText
- Next
- R = R + 1
- Next
- End With
- Exx:
- .Quit
- End With
- MsgBox "ok"
- End Sub
- Sub Ep(S As String)
- With CreateObject("InternetExplorer.Application")
- .Navigate "about:Tabs"
- ' .Visible = True
- .Document.body.innerHTML = S
- .ExecWB 17, 2 ' Select All
- .ExecWB 12, 2 ' Copy selection
- With Sheets(1)
- .UsedRange.Clear
- .Range("A1").Select
- .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
- End With
- .Quit
- End With
- End Sub
複製代碼 |
|