[發問] VBA如何處理網頁中的選擇項使網頁更新

Scott090

請高手大師相助

要取得網頁中的資料須先選擇項目，但就不知如何做
例如這個網頁，選擇其中一個選項頁面的內容就更新了

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. 
    
34. 
    
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

回復 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

回復 2# joey0415


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

謝謝

joey0415

回復 3# Scott090

都找到代碼就不要花心思了！只要改代碼就會知道溫度，把溫度抓下來即可

joey0415

下載 (68.68 KB)

2015-1-13 21:23

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

完全不用等

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

回復 5# joey0415


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

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

感恩

joey0415

回復 6# Scott090

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

不過要花了好多時間

1. Sub 觀測資料查詢系統()
   
2. 
   
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
    
13. 
    
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
    
20. 
    
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

回復 7# joey0415


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