[發問] 請問如何用 vba 點擊網頁查詢

本帖最後由 GBKEE 於 2016-2-18 12:54 編輯

網址： http://www.twse.com.tw/ch/tradin ... T/MI_5MINS_HIST.php
<input type=button class="board" value="查詢" onclick="date_form.submit();" >
查詢鈕無法點擊，跑出的資料非設定的查詢資料，
請教如何修改下列程式碼

Private Sub Worksheet_Change(ByVal Target As Range)

With Target
If .Row = 8 And .Column = 1 Then
If .Value <> 10 Then
   Dim A As Object, xDate As Date, EDATE As Date
   Dim myear, mmon
   'myear = Year(Worksheets("匯總").Cells(8, 1)) - 1911
   'mmon = Month(Worksheets("匯總").Cells(8, 1))
'***********測試用
'抓到有為止(只抓5天)，5天都抓不到也提示
Worksheets("加權指").Select
EDATE = Date
xDate = EDATE
xDate = Worksheets("匯總").Cells(8, 1)
'*************
'xDate = Date '正式常程式碼
With CreateObject("InternetExplorer.Application")
      .Visible = True
      .Navigate "http://www.twse.com.tw/ch/trading/indices/MI_5MINS_HIST/MI_5MINS_HIST.php"
      Do While .Busy Or .readyState <> 4: DoEvents: Loop
Ie_Refresh:
      With .Document
         .ALL("myear").Value = Year(xDate) - 1911 '日期可修改
         .ALL("mmon").Value = Format(Month(xDate), "0#")
         .ALL("查詢").Click


      End With
      Do While .Busy Or .readyState <> 4: DoEvents: Loop
      If InStr(.Document.BODY.innerText, "查無資料") Then
         If xDate >= EDATE Then '測試用********
         'If xDate + 4 >= Date Then '正式常程式碼
            Debug.Print xDate    '驗證用可刪除
            xDate = xDate - 1
            GoTo Ie_Refresh
         End If
         .Quit
         MsgBox Format(xDate, "E/MM/DD") & " 查無資料"
         Exit Sub

      End If
      Set A = .Document.GetElementsByTagName("table")
      .Document.BODY.innerHTML = A(10).outerHTML '取最後的一個"table"

      Do While .Busy Or .readyState <> 4: DoEvents: Loop
      .ExecWB 17, 2    '  Select All
      .ExecWB 12, 2    '  Copy selection
      '.Quit       '關閉網頁
      With ActiveSheet '可指定工作表
         .UsedRange.Clear
         .Range("A1").Select
         .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NOHTMLFormatting:=True
         Worksheets("匯總").Select
      End With
         End With
Else: .Offset(0, 1) = ""
End If
End If
End With
End Sub

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2015-3-26 07:42 | 只看該作者

回復 1# GaryC

With .Document
.all("myear").Value = Year(xDate) - 1913 '日期可修改
MsgBox .getElementsByName("myear")(0).Value
.all("mmon").Value = Format(Month(xDate) - 1, "0#")
For Each E In .GetElementsByTagName("INPUT")
If E.Value = "查詢" Then E.Click
Next
End With

複製代碼

每一個網頁(HTM )的建置都不一樣.

Option Explicit
Sub Ex_網頁元素()
Dim i As Integer, E As Object
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.twse.com.tw/ch/trading/indices/MI_5MINS_HIST/MI_5MINS_HIST.php"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
With .Document
'*** 這段程式碼可查看這網頁的元素內容
On Error Resume Next
For Each E In .all
i = i + 1
Cells(i, "a") = E.tagname '使用 .GetElementsByTagName("INPUT")
Cells(i, "b") = E.ID '使用 .GetElementByID("menu")
Cells(i, "c") = E.Name '使用 .all("myear")
'.getElementsByName("myear")(0).Value ' = Year(xDate) - 1911
' HTML 中通常具有相同的 name 屬性），所有 getElementsByName() 方法返回的是元素的集合，而不是單一個元素。
Cells(i, "d") = E.Value
Cells(i, "e") = E.innertext
Cells(i, "f") = E.Type
Cells(i, "g") = E.href
Next
End With
' .Quit '關閉網頁
End With
End Sub