Board logo

標題: [發問] VBA如何處理網頁中的選擇項使網頁更新 [打印本頁]

作者: Scott090    時間: 2015-1-13 17:45     標題: VBA如何處理網頁中的選擇項使網頁更新

請高手大師相助

要取得網頁中的資料須先選擇項目,但就不知如何做
例如這個網頁,選擇其中一個選項頁面的內容就更新了
  1. Sub EX()
  2.     Dim URL As String, A As Object, i As Integer, j%
  3.     Dim AA, BB, AB$, stationName$
  4.     URL = "http://e-service.cwb.gov.tw/HistoryDataQuery/index.jsp"
  5.     Application.StatusBar = "查詢網頁  ..."
  6.     With CreateObject("InternetExplorer.Application")
  7.         .Visible = True     '  是否顯示 IE
  8.         .Navigate URL
  9.         Do While .ReadyState <> 4
  10.             DoEvents
  11.         Loop
  12.         Application.Wait Time + #12:00:05 AM#                '等候網頁
  13.         Set A = .document.All
  14.         On Error Resume Next
  15.         For i = 0 To A.Length - 1
  16.             If A(i).tagname = "OPTION" Then
  17.                 If A.Item(i).Value <> "" Then
  18.                     AA = AA & "," & A(i).Value          '取得測站編碼
  19.                     BB = BB & "," & A(i).innertext      '取得選擇項
  20.                 End If
  21.             End If
  22.         Next
  23.         AA = Split(AA, ",")     'String to Array
  24.         BB = Split(BB, ",")
  25.         
  26. ' 底下是問題點,如何變換網頁中之 "測站" 選項 使頁面更新===============
  27. '======== 及 "資料格式" 選項 來更新網頁資料 ========================
  28. '        For i = 0 To UBound(BB)
  29. '            .document.getElementsBytagname("SELECT").Value = BB(i)
  30. '            .submit
  31. '        Next
  32. ' 以上是問題 =========================


  33.         .ExecWB 17, 2     'Select All
  34.         .ExecWB 12, 2     'Copy selection
  35.         
  36.         With ActiveSheet
  37.             .Cells.Clear
  38.             .Range("A1").Activate
  39.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
  40.                                 False, NoHTMLFormatting:=True
  41.         End With
  42.         
  43.         .Quit
  44.     End With
  45.     Application.StatusBar = False
  46. End Sub
複製代碼

作者: joey0415    時間: 2015-1-13 18:54

回復 1# Scott090

http://e-service.cwb.gov.tw/HistoryDataQuery/QueryDataController.do?command=doQueryStation&station_no=467610


    例如上面就是「成功」站的資料,結果如下
成功 (467610) |121°21' 55〞E|23°05' 57〞N|33.5M|臺東縣成功鎮公民路84號|中央氣象局

你只要把你想要的資料代碼改變就會有不同的地區資料

例如臺中 (467490)
http://e-service.cwb.gov.tw/HistoryDataQuery/QueryDataController.do?command=doQueryStation&station_no=467490
臺中 (467490) |120°40' 33〞E|24°08' 51〞N|84.04M|臺中市北區精武路295號|中央氣象局
作者: Scott090    時間: 2015-1-13 20:36

回復 2# joey0415


    請問如何用VBA 在網頁面的 "測站" 選項處做選擇呢?
亦即如果人工操作的話就是:1.按一下選項紐 2.在下拉展開的站別選擇, 頁面資料變了,網址仍然 停留在 "http://e-service.cwb.gov.tw/HistoryDataQuery/index.jsp"

謝謝
作者: joey0415    時間: 2015-1-13 21:00

回復 3# Scott090

都找到代碼就不要花心思了!只要改代碼就會知道溫度,把溫度抓下來即可
作者: joey0415    時間: 2015-1-13 21:25

[attach]20054[/attach]

就把區域代碼改一下放在上就知道案了

完全不用等
  1. Sub EX()
  2. finalrow=Cells(Rows.Count, 1).End(xlUp).Row
  3.     For i = 1 To finalrow
  4.         s = Cells(i, 1)
  5.         URL = "http://e-service.cwb.gov.tw/HistoryDataQuery/QueryDataController.do?command=doQueryStation&station_no=" & s
  6.         With CreateObject("InternetExplorer.Application")
  7.             .Visible = False     '  是否顯示 IE
  8.             .Navigate URL
  9.                 Do While .ReadyState <> 4
  10.                     DoEvents
  11.                 Loop
  12.             Set ieDoc = .Document
  13.             Cells(i, 2) = ieDoc.body.innerText
  14.             .Quit
  15.         End With
  16.     Next
  17.     Application.StatusBar = False
  18. End Sub
複製代碼

作者: Scott090    時間: 2015-1-13 22:21

回復 5# joey0415


    不好意思,請問
1. " http://e-service.cwb.gov.tw/HistoryDataQuery/QueryDataController.do?command=doQueryStation&station_no="
    是如何得到的 ?

2. 還是期望能直接變更選項的方法,是否煩請揭露

感恩
作者: joey0415    時間: 2015-1-14 10:12

本帖最後由 joey0415 於 2015-1-14 10:14 編輯

回復 6# Scott090

改好了!為了這個又學到東西

不過要花了好多時間
  1. Sub 觀測資料查詢系統()

  2.        ActiveSheet.Cells.Clear
  3.        URLb = "http://e-service.cwb.gov.tw/HistoryDataQuery/index.jsp"
  4.        Set ie = CreateObject("internetexplorer.application")
  5.        ie.Visible = True
  6.        ie.Navigate URLb
  7.        Do While ie.readyState <> 4 Or ie.Busy: DoEvents: Loop
  8.         Application.Wait Now + TimeValue("00:00:01") '等待頁面,過快會找不到資料
  9.         x = ie.document.all.tags("option").Length '查詢select共有幾項
  10.       Stop
  11.            For i = 0 To x '該網頁的option選項從0-35

  12.         '---------,內建的fireevent 的onchange失效,改用調用js的方法--------
  13.         Set evt = ie.document.createEvent("HTMLEvents")
  14.         evt.initEvent "change", True, False
  15.         Set lst = ie.document.getElementById("station") 'option的id是station
  16.         lst.selectedIndex = i '自動循環option的值,找到index
  17.         lst.dispatchEvent evt

  18.          Do While ie.readyState <> 4 Or ie.Busy: DoEvents: Loop
  19.             Application.Wait Now + TimeValue("00:00:01")
  20. '            Cells(i + 1, 1) = Trim(ie.document.getelementsbytagname("table")(1).innertext)'若找talbe是第一個,但空白過多要處理
  21.             Cells(i + 1, 1) = Trim(ie.document.getelementsbytagname("td")(4).innertext) '若找td是第4個下面亦同
  22.             Cells(i + 1, 2) = Trim(ie.document.getelementsbytagname("td")(5).innertext)
  23.             Cells(i + 1, 3) = Trim(ie.document.getelementsbytagname("td")(6).innertext)
  24.             Cells(i + 1, 4) = Trim(ie.document.getelementsbytagname("td")(7).innertext)
  25.             Cells(i + 1, 5) = Trim(ie.document.getelementsbytagname("td")(8).innertext)
  26.             Cells(i + 1, 6) = Trim(ie.document.getelementsbytagname("td")(9).innertext)
  27.        Next
  28.                ie.Quit
  29.               ActiveSheet.Cells.EntireColumn.AutoFit     '  自動調整欄寬
  30.    End Sub
複製代碼

作者: Scott090    時間: 2015-1-14 12:42

回復 7# joey0415


    非常謝謝熱心地提供指導
有不少網頁資料是需要用透過選擇項目後才能轉到資料頁的,這個方法應該可以用到此類情況吧?




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)