jewayy

版大果然太強大了！
根據版大的code，仿照了另一個網頁的WEB輸入
portal.sw.nat.gov.tw/PPL/pages/integration/layout.jsp?appId=APGQAGB309
網頁查詢畫面如下：

下載 (73.08 KB)

2013-11-17 11:15

匯入EXCEL畫面如下：

下載 (15.14 KB)

2013-11-17 11:15

-----------------------------code---------------------------------------
Option Base 1
Sub Ex()
    Dim Ar, AA(), 出口報單號碼 As String, Sh As Worksheet
    出口報單號碼 = InputBox("出口報單號碼", "出口報單放行資料查詢", "BE  02XE580024")
    If 出口報單號碼 = "" Then Exit Sub
    Set Sh = ActiveSheet                                 '指定顯示資料的工作表 'ActiveSheet->作用中的工作表
    With CreateObject("Microsoft.XMLHTTP")
       .Open "GET", "http://portal.sw.nat.gov.tw/APGQ/GB309!query?&choice=D&declNo=" & 出口報單號碼, False
        .send
        Ar = Split(Replace(.responsetext, """", ""), ",")
        AA = Array(1, 8, 4, 7, 2, 14, 11)           'A欗的標題內容 Ar中陣列對應之索引值
        On Error GoTo Er                            '出口報單號碼 不正確會有錯誤:
        For i = 1 To UBound(AA)
            Sh.Cells(1 + i, "B") = Split(Ar(AA(i)), ":")(1)  'B欗
       Next
       AA = Array(5, 3, 10, 6, 12, 9)                 'C欗的標題內容 Ar中陣列對應之索引值
       For i = 1 To UBound(AA)
            Sh.Cells(2 + i, "D") = Split(Ar(AA(i)), ":")(1)  'D欗
            If AA(i) = 6 Then Cells(2 + i, "D") = Replace(Cells(2 + i, "D"), "\/", "/")
       Next
    End With
    Exit Sub
Er:
    Sh.[b2].Resize(7, 1) = ""
    Sh.[d2].Resize(7, 1) = ""
End Sub
-----------------------------code---------------------------------------
請問版大如何把內容的亂碼更改成正確的中文顯示，如：建新國際股份有限公司高雄分公司，長榮國際...

其實，自己比較偷懶，做的iqy只有以下簡單內容，參照EXCEL內的報單號碼可做批次的查詢，
只是回傳的結果如joey0415兄說的會有亂碼，如果有方法可以解決回傳亂碼的話就太好了~~
------------------------------------------
WEB
1
http://portal.sw.nat.gov.tw/APGQ/GB309!query
choice=D&declNo=["ID",""]

Selection=1
Formatting=None
------------------------------------------

c_c_lai

回復 10# GBKEE
感謝， Ex() 執行出來的結果實無法入目，還是您原來的程式碼較佳，
至於 "標題" 的問題我進入 Html 看了一下，豁然大悟，原來它是
使用 <TD> </TD> 處哩，所以也只好照單入座了。

joey0415

回復 10# GBKEE

請問超級版主

透過您的方法，大概知道怎麼切，我只會版主的方式修改如下：

1.     Sub Ex()
   
2.         Dim Ar, AA(), 出口報單號碼 As String, Sh As Worksheet
   
3.         出口報單號碼 = InputBox("出口報單號碼", "出口報單放行資料查詢", "BE  02XE580024")
   
4.         If 出口報單號碼 = "" Then Exit Sub
   
5.         Set Sh = ActiveSheet                                 '指定顯示資料的工作表 'ActiveSheet->作用中的工作表
   
6.         With CreateObject("Microsoft.XMLHTTP")
   
7.            .Open "GET", "http://portal.sw.nat.gov.tw/APGQ/GB315!query?declNo=" & 出口報單號碼, False
   
8.             .send
   
9.             Ar = Split(Replace(.responsetext, """", ""), ",")
   
10.             For i = 0 To UBound(Ar)
    
11.                 Sh.Cells(1 + i, 1) = Ar(i)  'B欗
    
12.            Next
    
13.            
    
14.             For i = 0 To UBound(Ar)
    
15.                 Sh.Cells(1 + i, 2) = Split(Sh.Cells(1 + i, 1), ":")(0) 'B欗
    
16.                 Sh.Cells(1 + i, 3) = Split(Sh.Cells(1 + i, 1), ":")(1) 'B欗
    
17.            Next

複製代碼

下載 (21.47 KB)

2013-11-17 12:25

請問版主：
AA = Array(1, 8, 4, 7, 2, 14, 11)           'A欗的標題內容 Ar中陣列對應之索引值
AA = Array(5, 3, 10, 6, 12, 9)                 'C欗的標題內容 Ar中陣列對應之索引值

是為了方便指定AR陣列中指定的元素，在放進想要的CELLS中嗎？

============================
           On Error GoTo Er                            '出口報單號碼 不正確會有錯誤:

它跳到
Er:
        Sh.[b2].Resize(7, 1) = ""
        Sh.[d2].Resize(7, 1) = ""
要讓這兩欄都設為空字串嗎？

如果要批次找100值放進去跑回圈，中間有錯的話
要放 on error resume next嗎？
或是這兩個方式有分別嗎？

謝謝

GBKEE

是為了方便指定AR陣列中指定的元素，在放進想要的CELLS中嗎?
如果要批次找100值放進去跑回圈，中間有錯的話
要放 on error resume next嗎？

回復 13# joey0415
沒錯是要放進想要的CELLS.

如果預期會有錯誤的程式碼之前 寫上 on error resume next ,程式就一直執行下去,如真有錯誤你是會不知道的
回復 11# jewayy

下載 (131.93 KB)

2013-11-17 15:49

1. Option Explicit
   
2. Option Base 1
   
3. Sub 口報單通關流程查詢()
   
4.     Dim 出口報單號碼 As String, Rng As Range, AR, S As Variant, E As Variant, i As Integer, W As String, II As Integer
   
5.     Dim Sh As Worksheet
   
6.     出口報單號碼 = InputBox("出口報單號碼", "出口報單放行資料查詢", "BE  02XE580024")
   
7.     If 出口報單號碼 = "" Then Exit Sub
   
8.     Set Sh = ActiveSheet
   
9.     '指定顯示資料的工作表 'ActiveSheet->作用中的工作表
   
10.     Set Rng = Sh.Range("b2:B9, D3:D7, D9, B11, D11")
    
11.     '**AR內容: 參照 **** 出口報單通關流程查詢(GB309) 網頁的原始檔*****
    
12.     AR = Array("transTypeCd", "vslRegNo", "declNo", "brokerBoxNoName", "mawb", "hawb", "declType", "relCondSubCd" _
    
13.     , "soNo", "custCd", "carrierAgencyCd", "arrangeNo", "examMethod", "debitMark", "firstSendDate", "lastSendDate")
    
14.     With CreateObject("Microsoft.XMLHTTP")
    
15.        .Open "GET", "http://portal.sw.nat.gov.tw/APGQ/GB309!query?&choice=D&declNo=" & 出口報單號碼, False
    
16.         .send
    
17.         S = Replace(.responsetext, """", "")
    
18.     End With
    
19.     i = 1
    
20.     '*********** 查詢結果 *****
    
21.     For Each E In Rng
    
22.         E = ""
    
23.         If InStr(S, AR(i)) Then
    
24.             W = Mid(Split(Mid(S, InStr(S, AR(i)) + Len(AR(i))), ",")(0), 2)
    
25.             E = IIf(InStr(LCase(W), "null"), "", W)
    
26.         End If
    
27.         i = i + 1
    
28.     Next
    
29.     '***************通關流程**********
    
30.     AR = Split(S, "data:[")(1)                          '攔截 "data:[" 後的字串
    
31.     AR = Split(AR, "]")(0)                              '攔截 "[" 前的字串
    
32.     AR = Replace(Mid(AR, 2, Len(AR) - 2), "null", " ")  '替換 "null" 為 " "
    
33.     AR = Replace(AR, "T", " ")                          '替換  "T"   為 " "
    
34.     AR = Split(AR, "},{")                               '以 "},{" 分割為陣列
    
35.     S = Array(4, 2, 0, 1, 3)
    
36.     Sh.Range("A13").CurrentRegion.Offset(1) = ""
    
37.     For i = 0 To UBound(AR)
    
38.         For II = 0 To UBound(S) - 1
    
39.             E = Split(AR(i), ",")(S(II + 1))            '以 S(II + 1)的值 取得 Split(AR(i), ",")陣列的索引值
    
40.             Sh.Cells(i + 14, "A").Offset(, II) = Mid(E, InStr(E, ":") + 1)
    
41.         Next
    
42.     Next
    
43. End Sub
    
44. '出口報單通關流程查詢(GB309) 網頁的原始檔
    
45. '<td class="resultHeader">海空運別</td><td id="transTypeCd" class="result">
    
46. '<td class="resultHeader" width="25%">海關通關號碼</td><td width="25%" id="vslRegNo" class="result">
    
47. '<td class="resultHeader" width="25%">裝貨單編號</td><td width="25%" id="soNo" class="result">
    
48. '<td class="resultHeader">報單號碼</td><td id="declNo" class="result">
    
49. '<td class="resultHeader">關區代碼</td><td id="custCd" class="result">
    
50. '<td class="resultHeader">報關業者箱號</td><td id="brokerBoxNoName" class="result">
    
51. '<td class="resultHeader">運輸業者/代理行代碼</td><td id="carrierAgencyCd" class="result">
    
52. '<td class="resultHeader">託運單主號</td><td id="mawb" class="result">
    
53. '<td class="resultHeader">理單號碼</td><td id="arrangeNo" class="result">
    
54. '<td class="resultHeader">託運單分號</td><td id="hawb" class="result">
    
55. '<td class="resultHeader">申請審驗方式</td><td id="examMethod" class="result">
    
56. '<td class="resultHeader">報單類別</td><td id="declType" class="result">
    
57. '<td class="resultHeader">放行附帶條件</td><td id="relCondSubCd" class="result">
    
58. '<td class="resultHeader">是否為沖退稅e化報單</td><td id="debitMark" class="result">
    
59. '<tr><td colspan="4" class="resultHeader">傳送總額交查至財稅中心的日期</td>
    
60. '<td class="resultHeader">第一次傳送日期</td><td id="firstSendDate" class="result">
    
61. '<td class="resultHeader">最後一次傳送日期</td><td id="lastSendDate" class="result">

複製代碼

c_c_lai

回復 14# GBKEE
謝謝您詳盡的解說，終於問題解決了。原因是早上執行時
顯示在 Excel 表單上的是一堆亂碼。下午我用 Debug 方式
執行才發覺是 Explorer 的解譯問題。IE (10) 與  Firefox 兩者
的 Decode 有些微的差異，如透過 IE 傳入值會有亂碼，反之、
則一切正常， 如下：

1. {"msg":"[執行成功]","transTypeCd":"海","totGrossWeight":49376,"destCd":"VNCLI",
   
2.   "totPackQty":"32","declType":"G5","relDate":"102\/09\/17",
   
3. "totPackQtyUnit":"PLT","declNo":"BE  02XE580024","vslSign":"BKHC",
   
4. "examRelNote":"Y","voyageFlightNo":"1084-186S","marketMftNote":"Y",
   
5. "status":"ok","vslName":"UNI-PROSPER                        "}

複製代碼

我將 Ar = Split(Replace(.responsetext, """", ""), ",") 稍稍修改如下：

1. Ar = Split(Trim(Replace(Replace(.responsetext, """", ""), "}", "")), ",")

複製代碼

1. Ar(0) =  "msg:[執行成功]"
   
2. Ar(1) =  "transTypeCd:海"
   
3. Ar(2) =  "totGrossWeight":49376
   
4. Ar(3) =  "destCd:VNCLI"
   
5. Ar(4) =  "totPackQty:32"
   
6. Ar(5) =  "declType:G5"
   
7. Ar(6) =  "relDate:102\/09\/17"
   
8. Ar(7) =  "totPackQtyUnit:PLT"
   
9. Ar(8) =  "declNo:BE  02XE580024"
   
10. Ar(9) =  "vslSign:BKHC"
    
11. Ar(10) =  "examRelNote:Y"
    
12. Ar(11) =  "voyageFlightNo:1084-186S"
    
13. Ar(12) =  "marketMftNote:Y"
    
14. Ar(13) =  "status:ok"
    
15. Ar(14) =  "vslName:UNI-PROSPER"

複製代碼

如此執行起便無瑕玼了，謝謝您！

joey0415

回復 15# c_c_lai

Ar = Split(Trim(Replace(Replace(.responsetext, """", ""), "}", "")), ",")

請問程式碼的最中的核心柝解成陣列，再分柝時需要另命陣列嗎？否則再柝解時

比如柝成五個元素，可以再同時往下一起柝嗎？

謝謝
============================
我看錯了，原來是先取代
" =>空字串
}=>空字串

{=>空字串
\=>空字串

最後才柝分

c_c_lai

回復 16# joey0415

1.         '  http://portal.sw.nat.gov.tw/APGQ/GB315!query?declNo=BE++02XE580024
   
2.         '  "GET" 傳入 (Send) 之 XML 內容：
   
3.         '  {"msg":"[執行成功]","transTypeCd":"海","totGrossWeight":49376,"destCd":"VNCLI",
   
4.         '  "totPackQty":"32","declType":"G5","relDate":"102\/09\/17",
   
5.         '  "totPackQtyUnit":"PLT","declNo":"BE  02XE580024","vslSign":"BKHC",
   
6.         '  "examRelNote":"Y","voyageFlightNo":"1084-186S","marketMftNote":"Y",
   
7.         '  "status":"ok","vslName":"UNI-PROSPER                        "}
   
8.         AR = Split(Trim(Replace(Replace(.responsetext, """", ""), "}", "")), ",")
   
9.         '  先去除 "、再者去除 }、接下來再將前後空白 (Space) 清空；最後才處理 Split() 並 Assign 給 AR
   
10.         '  Ar :  Variant/String(0 to 14)
    
11.         '  Ar(0) =  "msg:[執行成功]"
    
12.         '  Ar(1) =  "transTypeCd:海"
    
13.         '  Ar(2) =  "totGrossWeight":49376
    
14.         '  Ar(3) =  "destCd:VNCLI"
    
15.         '  Ar(4) =  "totPackQty:32"
    
16.         '  Ar(5) =  "declType:G5"
    
17.         '  Ar(6) =  "relDate:102\/09\/17"
    
18.         '  Ar(7) =  "totPackQtyUnit:PLT"
    
19.         '  Ar(8) =  "declNo:BE  02XE580024"
    
20.         '  Ar(9) =  "vslSign:BKHC"
    
21.         '  Ar(10) =  "examRelNote:Y"
    
22.         '  Ar(11) =  "voyageFlightNo:1084-186S"
    
23.         '  Ar(12) =  "marketMftNote:Y"
    
24.         '  Ar(13) =  "status:ok"
    
25.         '  Ar(14) =  "vslName:UNI-PROSPER"

複製代碼

stillfish00

1. Sub TEST11()
   
2.     Dim sID As String, sStatus As String
   
3.     Dim x
   
4.    
   
5.     sID = InputBox("出口報單號碼", "出口報單放行資料查詢", "BE  02XE580024")
   
6.     If sID = "" Then Exit Sub
   
7.    
   
8.     With CreateObject("InternetExplorer.Application")
   
9.         .Visible = True '是否顯示IE
   
10.         .Navigate "http://portal.sw.nat.gov.tw/APGQ/GB315"
    
11.         Do While .readyState <> 4: DoEvents: Loop
    
12.       
    
13.         Set x = .document.getElementById("myform").getElementsByTagName("input")
    
14.         x(0).Value = sID  '填入號碼
    
15.         x(1).Click  '查詢
    
16.         Do While .document.getElementById("statusMsg").Value = "": DoEvents: Loop
    
17.       
    
18.         sStatus = .document.getElementById("statusMsg").Value
    
19.         If InStr(sStatus, "[執行成功]") < 0 Then .Quit: MsgBox sStatus: Exit Sub
    
20.                        
    
21.         .document.body.innerHTML = .document.getElementById("queryResult").outerHTML
    
22.         .execwb 17, 2 'Select All
    
23.         .execwb 12, 2 'Copy selection
    
24.                
    
25.         ActiveSheet.[A1].Select
    
26.         ActiveSheet.PasteSpecial Format:="HTML" ', NoHTMLFormatting:=True
    
27.         .Quit
    
28.     End With
    
29. End Sub

複製代碼

GBKEE

回復 18# stillfish00

1. .document.body.innerHTML = .document.getElementById("queryResult").outerHTML

複製代碼

這招受教了

joey0415

回復 19# GBKEE

1. .document.body.innerHTML = .document.getElementById("queryResult").outerHTML

複製代碼

把.outerHTML的傳給.body.innerHTML   ?

請問超版，這句話怎解呢？

謝謝