麻辣家族討論版版 - Powered by Discuz! Board

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

複製代碼