GBKEE

回復 1# jewayy

1. Option Explicit
   
2. Sub 助航服務費查詢_GC319()
   
3.     Dim Element, 船舶呼號 As String, xi As Integer, i As Integer, k As Integer, j As Integer
   
4.     船舶呼號 = InputBox("船舶呼號")
   
5.     With CreateObject("InternetExplorer.Application")
   
6.        ' .Visible = True
   
7.         '.Navigate "http://portal.sw.nat.gov.tw/APGQ/GC319?request_locale=zh_TW"
   
8.         .Navigate "http://portal.sw.nat.gov.tw/APGQ/GC319"
   
9.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
   
10.         .Document.getelementbyid("queryType1").Click
    
11.         .Document.getelementbyid("vslSign").Value = 船舶呼號   '"9VDB7"
    
12.         For Each Element In .Document.getelementsbytagname("INPUT") '    這個迴圈找到按鈕是第幾個輸入項
    
13.             If Element.Type = "button" And Trim(Element.Value) = "查詢" Then
    
14.                 Element.Click
    
15.                 Exit For
    
16.             End If
    
17.         Next
    
18.         .Document.getelementsbytagname("SELECT")(0).Value = 30               '資料數
    
19.         .Document.getelementsbytagname("SELECT")(0).FireEvent ("onchange")   '讀取
    
20.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
    
21.         Application.Wait Time + #12:00:02 AM#
    
22.         If .Document.getelementbyid("statusMsg").Value <> "[執行成功]" Then
    
23.             MsgBox 船舶呼號 & vbLf & .Document.getelementbyid("statusMsg").Value
    
24.             .Quit
    
25.             Exit Sub
    
26.         End If
    
27.         Set Element = .Document.getelementsbytagname("TABLE") '
    
28.         With ActiveSheet
    
29.             .UsedRange.Clear
    
30.             k = 1
    
31.             For xi = 2 To 6
    
32.                 If xi <> 3 Then
    
33.                     For i = 0 To Element(xi).Rows.Length - 1
    
34.                         For j = 0 To Element(xi).Rows(i).Cells.Length - 1
    
35.                             .Cells(k, j + 1) = Element(xi).Rows(i).Cells(j).innertext
    
36.                     Next
    
37.                     k = k + 1
    
38.                     Next
    
39.                 End If
    
40.            Next
    
41.         End With
    
42.         .Quit
    
43.     End With
    
44.     MsgBox "Ok"
    
45. End Sub

複製代碼