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. ' 以上是問題 =========================


  35.         .ExecWB 17, 2     'Select All
  36.         .ExecWB 12, 2     'Copy selection
  37.         
  38.         With ActiveSheet
  39.             .Cells.Clear
  40.             .Range("A1").Activate
  41.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
  42.                                 False, NoHTMLFormatting:=True
  43.         End With
  44.         
  45.         .Quit
  46.     End With
  47.     Application.StatusBar = False
  48. 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 觀測資料查詢系統()

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

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

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

回復 7# joey0415


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



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