麻辣家族討論版版 - Powered by Discuz! Board

標題: 請問這個網頁如何用WEB查詢輸入excel [打印本頁]

作者: jewayy 時間: 2013-11-15 22:02 標題: 請問這個網頁如何用WEB查詢輸入excel

http://portal.sw.nat.gov.tw/PPL/pages/integration/layout.jsp?appId=APGQAGB315

出口報單號碼：BE 02XE580024

希望能將查詢結果，匯入EXCEL中，
小弟已經做了一個iqy,如下所示，但還是無法顯示，請各位先進幫忙，感激不盡！
----------------------------------------------------------------------------------------------
WEB
1
http://portal.sw.nat.gov.tw/PPL/pages/integration/layout.jsp?appId=APGQAGB315declNo=BE 02XE580024

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

作者: jewayy 時間: 2013-11-16 14:03

呵呵，謝謝您的回覆，被說的好像是不懂爬文的小白~~
之前小弟寫這種WEB匯入也不下10個(或許那些網頁比較適合自己粗淺的功力)，
在發文之前也爬過文，實在找不到解決的方法才求救大家的。

不曉得高手如您是否有更具建議性的回覆，在此多謝。

作者: c_c_lai 時間: 2013-11-16 15:13

本帖最後由 c_c_lai 於 2013-11-16 15:15 編輯

http://portal.sw.nat.gov.tw/PPL/pages/integration/layout.jsp?appId=APGQAGB315

出口報單號碼：BE 0 ...
jewayy 發表於 2013-11-15 22:02

出口報單號碼：BE 02XE580024 試試成 BE%2002XE580024

http://portal.sw.nat.gov.tw/PPL/pages/integration/layout.jsp?appId=APGQAGB315declNo=BE%2002XE580024

複製代碼

作者: jewayy 時間: 2013-11-16 17:28

謝謝您的回覆，不過好像還是沒有反應。

小弟再描述清楚一下，出口報單號碼"BE 02XE580024"，BE與02XE中間是必須有兩個空格才能查詢成功。
畫面查詢結果如下：
[attach]16739[/attach]

再麻煩各位給予支援，謝謝。

作者: c_c_lai 時間: 2013-11-16 17:34

本帖最後由 c_c_lai 於 2013-11-16 17:36 編輯

謝謝您的回覆，不過好像還是沒有反應。

小弟再描述清楚一下，出口報單號碼"BE 02XE580024"，BE與02XE中 ...
jewayy 發表於 2013-11-16 17:28

那就改成 BE%20%2002XE580024

http://portal.sw.nat.gov.tw/PPL/pages/integration/layout.jsp?appId=APGQAGB315declNo=BE%20%2002XE580024

複製代碼

作者: luhpro 時間: 2013-11-16 23:03

回復 5# jewayy
我試過直接給網址似乎網站並不會正常顯示資料,
另外從輸入資料後按查詢按紐時,
上方的網址也並沒有因而變動.

或許你應該改成用程式在出口報單號碼：旁的輸入框輸入資料,
然後模擬按下查詢按紐較易成功查詢到資料.

不過因為我也不太懂 Excel VBA 讀取網頁相關方式,
這就需要其他人來解答了.

作者: joey0415 時間: 2013-11-17 00:20

http://portal.sw.nat.gov.tw/APGQ/GB315!query?declNo=BE++02XE580024

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

[attach]16745[/attach]

可能要下xmlhttp下載
可果要用excel web查詢，我試過會亂碼，可能還要會轉碼

就要用ie法找到tag按下去，從裏面找table

提供兩個網頁參考：
http://club.excelhome.net/forum.php?mod=viewthread&action=printable&tid=939881

http://blog.csdn.net/a814153a/article/details/9071577

作者: GBKEE 時間: 2013-11-17 07:16

回復 4# jewayy

[attach]16746[/attach]

Option Explicit
Dim IE As Object
Sub 出口報單放行資料查詢()
Dim 出口報單號碼 As String, n As Object
出口報單號碼 = InputBox("出口報單號碼", "出口報單放行資料查詢", "BE 02XE580024")
If 出口報單號碼 = "" Then Exit Sub
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://portal.sw.nat.gov.tw/APGQ/GB315?request_locale=zh_TW&declNo=" & 出口報單號碼
Do While .Busy = True
DoEvents
Loop
For Each n In .document.getelementsbytagname("INPUT")
If n.Value = "查詢" Then
n.Click '網頁按下查詢
Exit For
End If
Next
Application.Wait (Time + TimeValue("0:00:03")) '依網頁下載速度調整等待秒數
Set IE = .document
查詢結果
.Quit
End With
End Sub
Private Sub 查詢結果()
Dim Ar(1 To 7), SH As Worksheet
'***** 網頁的原始檔案的本文
'<tbody><tr><td colspan="4" class="resultHeader">查詢結果</td></tr>
'<td class="resultHeader">海空運別</td><td class="result" id="transTypeCd">海</td>
'<td class="resultHeader" width="25%">出口報單號碼</td><td width="25%" class="result" id="declNo">BE 02XE580024</td>
'<td class="resultHeader" width="25%">報單類別</td><td width="25%" class="result" id="declType">G5</td>
'<td class="resultHeader" width="25%">總件數</td><td width="25%" class="result" id="totPackQty">32</td>
'<td class="resultHeader" width="25%">目的國家代碼</td><td width="25%" class="result" id="destCd">VNCLI</td>
'<td class="resultHeader" width="25%">總件數單位</td><td width="25%" class="result" id="totPackQtyUnit">PLT</td>
'<td class="resultHeader" width="25%">報單放行註記</td><td width="25%" class="result" id="examRelNote">Y</td>
'<td class="resultHeader" width="25%">總毛重</td><td width="25%" class="result" id="totGrossWeight">49376</td>
'<td class="resultHeader" width="25%">放行日期</td><td width="25%" class="result" id="relDate">102/09/17</td>
'<td class="resultHeader" width="25%">船舶名稱(海)/航機名稱(空)</td><td width="25%" class="result" id="vslName">UNI-PROSPER </td>
'<td class="resultHeader" width="25%">銷艙註記</td><td width="25%" class="result" id="marketMftNote">Y</td>
'<td class="resultHeader" width="25%">船舶航次(海)/航機班次(空)</td><td width="25%" class="result" id="voyageFlightNo">1084-186S</td>
'<td class="resultHeader" width="25%">船舶呼號(海)</td><td width="25%" class="result" id="vslSign">BKHC</td>
'<input id="statusMsg" type="text" class="msgText uppercase" readonly="readonly" style="width: 775px; color: red;">
Set SH = ActiveSheet '指定顯示資料的工作表 'ActiveSheet->作用中的工作表
If InStr(IE.getElementById("statusMsg").Value, "[執行成功]") = 0 Then
SH.[b2].Resize(7, 1) = Application.WorksheetFunction.Transpose(Ar)
SH.[d2].Resize(7, 1) = Application.WorksheetFunction.Transpose(Ar)
Exit Sub
End If
Ar(1) = IE.getElementById("transTypeCd").innertext '海空運別
Ar(2) = IE.getElementById("declNo").Value '出口報單號碼
Ar(3) = IE.getElementById("totPackQty").innertext '總件數
Ar(4) = IE.getElementById("totPackQtyUnit").innertext '總件數單位
Ar(5) = IE.getElementById("totGrossWeight").innertext '總毛重
Ar(6) = IE.getElementById("vslName").innertext '船舶名稱 (海) / 航機名稱(空)
Ar(7) = IE.getElementById("voyageFlightNo").innertext '船舶航次 (海) / 航機班次(空)
SH.[b2].Resize(7, 1) = Application.WorksheetFunction.Transpose(Ar)
Ar(1) = ""
Ar(2) = IE.getElementById("declType").innertext '報單類別
Ar(3) = IE.getElementById("destCd").innertext '目的國家代碼
Ar(4) = IE.getElementById("examRelNote").innertext '報單放行註記
Ar(5) = IE.getElementById("totGrossWeight").innertext '放行日期
Ar(6) = IE.getElementById("marketMftNote").innertext '銷艙註記
Ar(7) = IE.getElementById("vslSign").innertext '船舶呼號 (海)
SH.[d2].Resize(7, 1) = Application.WorksheetFunction.Transpose(Ar)
SH.Columns.AutoFit
End Sub

複製代碼

作者: c_c_lai 時間: 2013-11-17 08:12

回復 8# GBKEE

Ar(2) = IE.getElementById("declNo").Value '出口報單號碼

複製代碼

要改成

Ar(2) = IE.getElementById("declNo").innertext '出口報單號碼

複製代碼

才不會產生 438的錯誤訊息。
很棒的詮釋！順帶請教一下，如果我要連同每個標題 (如：查詢結果、海空運別、出口報單號碼等)
一併下載，應該要如何處理？
謝謝您！

作者: GBKEE 時間: 2013-11-17 08:55

本帖最後由 GBKEE 於 2013-11-17 09:06 編輯

回復 9# c_c_lai
EXCEL 2003, IE 8  或許是版本不同  declNo=>tagname("INPUT") 要用 VALUE
IE8 Ar(2) = IE.getElementById("declNo").innertext    '出口報單號碼  會傳回空字串
要連同每個標題嗎我@*#@*#@*#

參考7# joey0415  給的網址 http://portal.sw.nat.gov.tw/APGQ/GB315!query?declNo=BE++02XE580024
可捨去8#的程式碼 ,  如在 8# 圖片的工作表,這程式碼就簡便了.

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/GB315!query?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
End Sub

複製代碼

作者: jewayy 時間: 2013-11-17 11:21

版大果然太強大了！
根據版大的code，仿照了另一個網頁的WEB輸入
portal.sw.nat.gov.tw/PPL/pages/integration/layout.jsp?appId=APGQAGB309
網頁查詢畫面如下：
[attach]16747[/attach]
匯入EXCEL畫面如下：
[attach]16748[/attach]
-----------------------------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 時間: 2013-11-17 12:29

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

作者: joey0415 時間: 2013-11-17 12:37

回復 10# GBKEE

請問超級版主

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

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/GB315!query?declNo=" & 出口報單號碼, False
.send
Ar = Split(Replace(.responsetext, """", ""), ",")
For i = 0 To UBound(Ar)
Sh.Cells(1 + i, 1) = Ar(i) 'B欗
Next
For i = 0 To UBound(Ar)
Sh.Cells(1 + i, 2) = Split(Sh.Cells(1 + i, 1), ":")(0) 'B欗
Sh.Cells(1 + i, 3) = Split(Sh.Cells(1 + i, 1), ":")(1) 'B欗
Next

複製代碼

[attach]16749[/attach]

請問版主：
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 時間: 2013-11-17 15:52

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

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

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

[attach]16750[/attach]

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

複製代碼

作者: c_c_lai 時間: 2013-11-17 16:55

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

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

複製代碼

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

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

複製代碼

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

複製代碼

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

作者: joey0415 時間: 2013-11-17 20:52

本帖最後由 joey0415 於 2013-11-17 20:58 編輯

回復 15# c_c_lai

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

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

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

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

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

最後才柝分

作者: c_c_lai 時間: 2013-11-18 07:46

回復 16# joey0415

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

複製代碼

作者: stillfish00 時間: 2013-11-18 10:16

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

複製代碼

作者: GBKEE 時間: 2013-11-18 11:04

回復 18# stillfish00

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

複製代碼

這招受教了

作者: joey0415 時間: 2013-11-18 11:59

本帖最後由 joey0415 於 2013-11-18 12:00 編輯

回復 19# GBKEE

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

複製代碼

把.outerHTML的傳給.body.innerHTML ?

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

謝謝

作者: GBKEE 時間: 2013-11-18 14:13

本帖最後由 GBKEE 於 2013-11-18 14:16 編輯

回復 20# joey0415
.document(文件).body(本體).innerHTML(代碼,文字) = .document.getElementById("queryResult").outerHTML(輸出的:代碼,文字)
可在這行程式碼設下中斷點,看一下網頁前後的變化

作者: c_c_lai 時間: 2013-11-18 15:25

本帖最後由 c_c_lai 於 2013-11-18 15:27 編輯

回復 18# stillfish00
請教一下，我把 .Navigate "http://portal.sw.nat.gov.tw/APGQ/GB315" 換成
.Navigate "http://portal.sw.nat.gov.tw/APGQ/GB309" 出口報單通關流程查詢

Set x = .document.getElementById("myform").getElementsByTagName("input")
x(2).Value = sID ' 填入號碼 (原本為 x(0).Value = sID )
x(11).Click ' 查詢 (原本為 x(1).Click )

複製代碼

執行到 ActiveSheet.PasteSpecial Format:="HTML" 卻發生了錯誤訊息，
請問應如何修正方屬正確？謝謝你！

作者: GBKEE 時間: 2013-11-18 15:58

本帖最後由 GBKEE 於 2013-11-18 16:06 編輯

回復 22# c_c_lai

For Each x In .document.getElementsByTagName("input")
If x.Name = "declNo" Then x.Value = sID
If x.Value = "查詢" Then x.Click
Next

複製代碼

這行也要修改 =0

If InStr(sStatus, "[執行成功]") = 0 Then .Quit: MsgBox sStatus: Exit Sub

複製代碼

作者: c_c_lai 時間: 2013-11-18 16:56

回復 23# GBKEE
多謝了！
正當我測試完成時，正好亦看到您送來的訊息，
對我幫助甚大，亦將您的註釋加入並應用，
再次言謝！

Sub 出口報單放行單查詢結果()
Dim sID As String, sStatus As String
Dim x
sID = InputBox("出口報單號碼", "出口報單放行資料查詢", "BE 02XE580024")
If sID = "" Then Exit Sub
With CreateObject("InternetExplorer.Application")
.Visible = True ' 是否顯示 IE
.Navigate "http://portal.sw.nat.gov.tw/APGQ/GB309"
Do While .readyState <> 4
DoEvents
Loop
' Set x = .document.getElementById("myform").getElementsByTagName("input")
' x(1).Value = sID ' 填入號碼 ("declNo")
' x(10).Click ' 查詢 ("查詢")
' 對於 x 的運用，此上下兩種表達方式決果一致；然下列方式可避免判斷上之誤判情事。
For Each x In .document.getElementsByTagName("input")
If x.Name = "declNo" Then x.Value = sID
If x.Value = "查詢" Then x.Click
Next
Do While .document.getElementById("statusMsg").Value = ""
DoEvents
Loop
sStatus = .document.getElementById("statusMsg").Value
If InStr(sStatus, "[執行成功]") <= 0 Then .Quit: MsgBox sStatus: Exit Sub
.document.body.innerHTML = .document.getElementById("queryResult").outerHTML
.execwb 17, 2 ' Select All
.execwb 12, 2 ' Copy selection
ActiveSheet.[A1].Select
ActiveSheet.PasteSpecial Format:="HTML" ', NoHTMLFormatting:=True
.Quit
End With
End Sub

複製代碼

[attach]16760[/attach]

作者: stillfish00 時間: 2013-11-18 17:19

回復 joey0415
.document(文件).body(本體).innerHTML(代碼,文字) = .document.getElementById("queryRe ...
GBKEE 發表於 2013-11-18 14:13

補充一下 innerHTML 和 outerHTML 不同:
.getElementById("queryResult").outerHTML 是指包含自身標籤的html代碼，如 <table id="queryResult"><tr>blahblah..</tr></table>
.getElementById("queryResult").innerHTML 是不包含自身標籤，只有內部的html代碼，即<tr>blahblah..</tr>

作者: GBKEE 時間: 2013-11-18 17:29

回復 25# stillfish00
感謝補足說明
回復 24# c_c_lai
如果這些出口報單放行單查詢的網頁相類似的可如此 (改一下stillfish00的程式碼)

Option Explicit
Sub 出口查詢()
Dim sID As String, sStatus As String, URL As String
Dim x
URL = InputBox("1:出口報單放行資料查詢(產證專用)(GB315)" & vbLf & "2:出口報單通關流程查詢(GB309)", "出口資料查詢", 1)
If URL = "" Or (URL <> "1" And URL <> "2") Then Exit Sub
URL = IIf(URL = "1", "GB315", "GB309")
sID = InputBox("出口報單號碼", "出口報單放行資料" & URL & "查詢", "BE 02XE580024")
If sID = "" Then Exit Sub
URL = "http://portal.sw.nat.gov.tw/APGQ/" & URL & "?&declNo=" & sID
With CreateObject("InternetExplorer.Application")
.Visible = True ' 是否顯示 IE
.Navigate URL
Do While .readyState <> 4
DoEvents
Loop
For Each x In .document.getElementsByTagName("input")
If x.Value = "查詢" Then x.Click: Exit For
Next
Do While .document.getElementById("statusMsg").Value = ""
DoEvents
Loop
sStatus = .document.getElementById("statusMsg").Value
If InStr(sStatus, "[執行成功]") <= 0 Then .Quit: MsgBox sStatus: Exit Sub
.document.body.innerHTML = .document.getElementById("queryResult").outerHTML
.execwb 17, 2 ' Select All
.execwb 12, 2 ' Copy selection
With ActiveSheet
.Cells.Clear
.[A1].Select
.PasteSpecial Format:="HTML"
End With
.Quit
End With
End Sub

複製代碼

作者: c_c_lai 時間: 2013-11-18 18:15

回復 26# GBKEE
彙整的蠻貼心的，在尾端我順便加上了自動調整蘭寬的處裡。

With ActiveSheet
.Cells.Clear
.[A1].Select
.PasteSpecial Format:="HTML"
.Cells.EntireColumn.AutoFit ' 自動調整欄寬
End With

複製代碼

謝謝囉！

作者: joey0415 時間: 2013-11-18 22:02

本帖最後由 joey0415 於 2013-11-18 22:04 編輯

回復 26# GBKEE

請問超級版主

以這方式來抓鉅享網來練習時，程式碼如下

Sub TEST11()
Dim x
With CreateObject("InternetExplorer.Application")
.Visible = True '是否顯示IE
.Navigate "http://www.cnyes.com/twstock/Institutional/1101.htm"
Do While .readyState <> 4: DoEvents: Loop
Set x = .document.getElementById("a_itrust")
x.Click
Do While .readyState <> 4: DoEvents: Loop
.document.body.innerHTML = .document.getElementById("tabvl").outerHTML
.execwb 17, 2 'Select All
.execwb 12, 2 'Copy selection
ActiveSheet.[A1].Select
ActiveSheet.PasteSpecial Format:="HTML" ', NoHTMLFormatting:=True
.Quit
End With
End Sub

複製代碼

到這一行會出錯，如圖
.document.body.innerHTML = .document.getElementById("tabvl").outerHTML

我以鉅亨網中的投信進出為例子練習

再問一個困擾很久的問題
.getElementById與.getElementsByTagName
有些有id與tagname 有些只有id ，有些只有tagname
請問有先後從屬的關係嗎？

若有父子關係把子設為x的話，那父層就不能表示嗎？還是先父層再加一個「點」

若這樣設x=.document.getElementById("tabvl") 出錯

請版主指點一下

[attach]16762[/attach]

作者: c_c_lai 時間: 2013-11-19 07:19

回復 28# joey0415
試試這個：

Sub 鉅享網()
Dim sID As String, sStatus As String, URL As String
Dim x
URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"
With CreateObject("InternetExplorer.Application")
.Visible = True ' 是否顯示 IE
.Navigate URL
Do While .readyState <> 4
DoEvents
Loop
For Each x In .Document.getelementsbytagname("input")
If x.Value = "查詢" Then x.Click: Exit For
Next
.Document.body.innerHTML = .Document.getelementsbytagname("table")(1).outerHTML
.execwb 17, 2 ' Select All
.execwb 12, 2 ' Copy selection
With ActiveSheet
.Cells.Clear
.[A2].Select
.PasteSpecial Format:="HTML"
.Cells.EntireColumn.AutoFit ' 自動調整欄寬
End With
.Quit
End With
End Sub

複製代碼

作者: c_c_lai 時間: 2013-11-19 07:22

回復 28# joey0415
因為我的 FireFox 無法使用上傳圖片與附件，所以才另外用 IE 上傳
[attach]16764[/attach]

作者: GBKEE 時間: 2013-11-19 07:36

本帖最後由 GBKEE 於 2013-11-19 08:05 編輯

回復 28# joey0415
有些有id與tagname 有些只有id ，但一定會有tagname
摘取網頁原使檔一段內容 <input type="hidden" name="__VIEWSTATE" id="__VIEWSTATE" value="" />
getElementsBytagname("input")    '會是原使檔所有<input type=???  .....>  的集合
getElementsByName("__VIEWSTATE")  '唯一的 Name
getElementById("__VIEWSTATE")    '唯一的 Id

Option Explicit
Sub TEST11()
Dim x
With CreateObject("InternetExplorer.Application")
.Visible = True '是否顯示IE
.Navigate "http://www.cnyes.com/twstock/Institutional/1101.htm"
Do While .readyState <> 4: DoEvents: Loop
Set x = .document.getElementById("a_itrust")
x.Click ' 轉到網頁: 'http://www.cnyes.com/twstock/itrust/1101.htm '
Do While .readyState <> 4: DoEvents: Loop
' .document.body.innerHTML = .document.getElementById("tabvl").outerHTML '網頁文件元素沒這 Id="tabvl"
.document.body.innerHTML = .document.getElementsBytagname("table")(1).outerHTML 'tagname成員從 0 開始
.execwb 17, 2 'Select All
.execwb 12, 2 'Copy selection
ActiveSheet.[A1].Select
ActiveSheet.PasteSpecial Format:="HTML" ', NoHTMLFormatting:=True
.Quit
End With
End Sub

複製代碼

作者: joey0415 時間: 2013-11-19 10:31

回復 30# c_c_lai

感謝大大分享，我昨天最後也用table來找
不過請問大大.Document.getelementsbytagname("table")(1).outerHTML

中的1是怎麼算的，我算的是2，網頁的table有固定算法嗎？由上而下，尤左而右嗎？
感謝

作者: GBKEE 時間: 2013-11-19 11:45

本帖最後由 GBKEE 於 2013-11-19 11:54 編輯

回復 32# joey0415
IQY 查詢檔的內容(副檔名為 IQY ,存於記事本,小作家.)

WEB
1
http://www.cnyes.com/twstock/itrust/1101.htm
'投信進出網頁 'Selection => table的索引值 ,IQY文件由1開始算起, VBA程式由0 開始算起
Selection=2
Formatting=None
PreFormattedTextToColumns=True
ConsecutiveDelimitersAsOne=True
SingleBlockTextImport=False
DisableDateRecognition=False
DisableRedirections=False

複製代碼

作者: joey0415 時間: 2013-11-19 13:30

回復 33# GBKEE

謝謝版主！我大概知道了！
謝謝

請教一下，鉅亨網的網頁常會定時重新整理
若要用上面的方法抓取時，最後不要quit
只想要將body.innertext內容放上去，不要讓鉅亨網再重新整理成原來的畫面，要加上什麼語句呢？

作者: GBKEE 時間: 2013-11-19 13:49

本帖最後由 GBKEE 於 2013-11-19 13:51 編輯

回復 34# joey0415
我把它放著沒有[重新整理成原來的畫面]
若要用上面的方法抓取時，最後不要quit,不quit要何作用.

作者: c_c_lai 時間: 2013-11-19 21:49

回復 32# joey0415
搜尋 "<table"
(0) <table border='0' cellspacing='0' cellpadding='0'><tr><td width='16%'>
(1) <table>
                     <h3>近一個月三大法人買賣超總表</h3>
(2) <table>
                        <caption>
                              <a href="#">外資買賣超</a></caption>
(3) <table>
                        <caption>
                              <a href="#">投信買賣超</a></caption>
(4) <table>
                        <caption>
                              <a href="#">自營商買賣超</a></caption>
(5) <table>
                        <caption>
                              <a href="#">三大法人買賣超</a></caption>
[attach]16785[/attach]

作者: joey0415 時間: 2013-11-19 22:58

本帖最後由 joey0415 於 2013-11-19 23:02 編輯

回復 36# c_c_lai
我後來用excelhome 藍天大的分析法，只要輸入網頁，每個tag是哪一個都跑不掉，非常好用

還是感謝指點，教學相長

[attach]16787[/attach]

作者: c_c_lai 時間: 2013-11-20 09:37

回復 37# joey0415
謝謝你！
如果我想要測試 "http://www.cnyes.com/twstock/Institutional/1101.htm"
該如何應用 "查找標籤"？

作者: c_c_lai 時間: 2013-11-20 09:45

回復 37# joey0415
它好像無法檢測出 table。

作者: joey0415 時間: 2013-11-20 11:40

回復 38# c_c_lai

將網址貼在首頁的 A1

再按查詢

點擊該單元格就會看到內容

[attach]16793[/attach]

作者: joey0415 時間: 2013-11-20 11:49

回復 35# GBKEE

小弟又換了一個網站
這個網站我會用好幾種方法抓了，只不過這次換成這種方式時，如果直接run結果，會出現如下圖，卡在那一句話
表格("table")(7)是對的，因為有成功過
.document.body.innerHTML = .document.getelementsbytagname("table")(7).outerHTML
[attach]16794[/attach]
如果按F8一步步執行時，有時候會成功，有時候會失敗

Sub test1()
Dim URL As String
ActiveSheet.Cells.Clear
URL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
With CreateObject("InternetExplorer.Application")
.Visible = True ' 是否顯示 IE
.Navigate URL
Do While .readyState <> 4: DoEvents: Loop
.document.All.tags("option")(7).Selected = True
.document.getelementsbytagname("input")(1).Value = "2330"
.document.getelementsbytagname("input")(4).Click
Do While .readyState <> 4: DoEvents: Loop
.document.body.innerHTML = .document.getelementsbytagname("table")(7).outerHTML
.execwb 17, 2 ' Select All
.execwb 12, 2 ' Copy selection
With ActiveSheet
.Cells.Clear
.[A1].Select
.PasteSpecial Format:="HTML", NoHTMLFormatting:=True
.Cells.EntireColumn.AutoFit ' 自動調整欄寬
End With
.Quit
End With
End Sub

複製代碼

作者: c_c_lai 時間: 2013-11-20 11:56

回復 40# joey0415
了解！但只是無法明確地看出 Table 的單元，
即 (0)、(1)、(2)、 . . . .等等。
謝謝！

作者: GBKEE 時間: 2013-11-20 12:37

回復 41# joey0415

Do While .readyState <> 4: DoEvents: Loop

複製代碼

改成

Do While .readyState <> 4 Or .Busy: DoEvents: Loop

複製代碼

作者: joey0415 時間: 2013-11-20 13:13

回復 42# c_c_lai

點擊innertext的該單元格，就看到內容呀！

[CA4]那格就知道了，真的清楚，往左一看就知道是指TABLE 1

作者: joey0415 時間: 2013-11-20 13:19

本帖最後由 joey0415 於 2013-11-20 13:27 編輯

回復 43# GBKEE

請問超版，平常都要加載完成，才做下一步！若不完成，可能要找的資料沒有找到會出錯

而BUSY 與完全的差異又在哪呢？請指教一下

如果主的方法是正確的，那以後只有下載有關的語法都要改成這樣，還是只有這網站才要特別如此呢？

謝謝超版
==========================
請問超版：
如果已查詢一個網址後，已將網站內容改成下句
.document.body.innerHTML = .document.getElementsBytagname("table")
，如果貼上後，還要回到當初的畫面再往下查另一個資料，而我又不想再CREAT另一個IE，只想用目前的IE，在不重啟的方式下，如何再轉回當初的畫面，再往下查呢？
謝謝

作者: c_c_lai 時間: 2013-11-20 14:01

回復 44# joey0415
[attach]16798[/attach]
恍然大悟，謝謝囉！

作者: ML089 時間: 2013-11-20 15:55

回復 46# c_c_lai

可否分享一下，我還是看不懂 ^_^

作者: c_c_lai 時間: 2013-11-20 17:56

回復 47# ML089
[attach]16803[/attach]
[attach]16804[/attach]

作者: c_c_lai 時間: 2013-11-20 17:57

回復 47# ML089
[attach]16805[/attach]
[attach]16806[/attach]

作者: c_c_lai 時間: 2013-11-20 17:58

回復 47# ML089
[attach]16807[/attach]
[attach]16808[/attach]

作者: c_c_lai 時間: 2013-11-20 18:02

回復 47# ML089
以上圖解瞭解否？

作者: c_c_lai 時間: 2013-11-20 19:32

回復 45# joey0415
參考：

Sub 鉅享網()
Dim URL As String, shts As Worksheet
Dim x As Variant, xi As Integer
Set shts = Sheets("工作表2")
URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"
With CreateObject("InternetExplorer.Application")
.Visible = True ' 是否顯示 IE
.Navigate URL
shts.Cells.Clear
For xi = 1 To 6
Do While .readyState <> 4 Or .Busy
DoEvents
Loop
For Each x In .document.getElementsBytagname("input")
If x.Value = "查詢" Then x.Click: Exit For
Next
.document.body.innerHTML = .document.getElementsBytagname("table")(xi).outerHTML
.execwb 17, 2 ' Select All
.execwb 12, 2 ' Copy selection
With shts
.Range("A" & .[A65535].End(xlUp).Row + 1).Select
.PasteSpecial Format:="HTML"
End With
Next xi
shts.Cells.EntireColumn.AutoFit ' 自動調整欄寬
.Quit
End With
End Sub

複製代碼

作者: ML089 時間: 2013-11-20 21:15

回復 51# c_c_lai

點進去才之別有洞天

感謝! 圖解說明作的真用心

作者: GBKEE 時間: 2013-11-21 15:41

回復 45# joey0415

Busy = True
Busy = False
READYSTATE_UNINITIALIZED = 0
READYSTATE_LOADING = 1
READYSTATE_LOADED = 2
READYSTATE_INTERACTIVE = 3
READYSTATE_COMPLETE = 4

複製代碼

不想再CREAT另一個IE : 52# c_c_lai 已寫出了
回復 52# c_c_lai
在2003有錯誤修正如下

Option Explicit
Sub 鉅享網()
Dim URL As String, shts As Worksheet
Dim x As Variant, xi As Integer, A As Object, xlHtm
Set shts = ActiveSheet ' '("工作表2")
shts.Cells.Clear
URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"
With CreateObject("InternetExplorer.Application")
.Visible = True ' 是否顯示 IE
.Navigate URL
Do While .ReadyState <> 4 Or .Busy
DoEvents
Loop
For Each x In .Document.getElementsBytagname("input")
If x.Value = "查詢" Then x.Click: Exit For
Next
Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
xlHtm = .Document.body.innerHTML '儲存
Set A = .Document.getElementsBytagname("table")
For xi = 1 To 6
.Document.body.innerHTML = A(xi).outerHTML
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
With shts
.Range("A" & .[A65535].End(xlUp).Row + 1).Select
.PasteSpecial Format:="HTML"
End With
.Document.body.innerHTML = xlHtm '還原
Next xi
shts.Cells.EntireColumn.AutoFit ' 自動調整欄寬
.Quit
End With
End Sub

複製代碼

作者: c_c_lai 時間: 2013-11-21 17:31

回復 54# GBKEE
原本我亦是如您所寫的 (For ~ Next) 方式處哩，但它在 2010 版大約在第二迴圈便會出現
錯誤訊息，所以只能將 For 往上擺放，每次都再執行 Click 的動作，一切便順心了。
看樣子就像統計圖表繪製有些語法處理之適用問題一樣，只能依版本見機行事，
謝謝您！

作者: GBKEE 時間: 2013-11-21 18:04

回復 55# c_c_lai
我 54# 修正的程式碼2010不可用?
2010請試試看這程式碼

Option Explicit
Sub 鉅享網()
Dim URL As String, shts As Worksheet, ie As Object
Dim x As Variant, A As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "about:Tabs"
ie.Visible = True
Set shts = ActiveSheet ' '("工作表2")
shts.Cells.Clear
URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"
With CreateObject("InternetExplorer.Application")
.Visible = True ' 是否顯示 IE
.Navigate URL
Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
For Each x In .Document.getElementsBytagname("input")
If x.Value = "查詢" Then x.Click: Exit For
Next
Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
Set A = .Document.getElementsBytagname("table")
For x = 1 To 6
With ie
.Document.body.innerHTML = A(x).outerHTML
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
End With
With shts
.Range("A" & .[A65535].End(xlUp).Row + 1).Select
.PasteSpecial Format:="HTML"
End With
Next
shts.Cells.EntireColumn.AutoFit ' 自動調整欄寬
.Quit
End With
ie.Quit
End Sub

複製代碼

作者: c_c_lai 時間: 2013-11-21 19:51

回復 56# GBKEE
只有一句話能形容 ---- Perfect!
[attach]16821[/attach]

作者: c_c_lai 時間: 2013-11-21 20:04

回復 56# GBKEE
如果把 Set ie 以及 ie.Quit 改成註釋，則會發生如圖之錯誤：
[attach]16822[/attach]

作者: c_c_lai 時間: 2013-11-21 20:24

回復 56# GBKEE
附上 54# 的程式執行結果：
[attach]16823[/attach]

作者: GBKEE 時間: 2013-11-21 21:01

回復 58# c_c_lai
如果把 Set ie 以及 ie.Quit 改成註釋，則會發生如圖之錯誤：錯誤行是哪一行?
註釋後ie變數就沒有指定物件,再使用到ie當然會錯誤.
回復 59# c_c_lai
圖中與54# 的程式碼有點不樣,明天再看看

作者: wufonna 時間: 2013-11-21 23:31

回復 56# GBKEE

請問 GBKEE 版主
ie.Navigate "about:Tabs"
作用是如何，謝謝

作者: GBKEE 時間: 2013-11-22 06:35

回復 61# wufonna [/b

[attach]16827[/attach]
作者: c_c_lai 時間: 2013-11-22 06:53

回復 60# GBKEE
(如果把 Set ie 以及 ie.Quit 改成註釋)
附上測試用程式碼：
Sub 鉅享網2()

Dim URL As String, shts As Worksheet, ie As Object

Dim x As Variant, A As Object

'  Set ie = CreateObject("InternetExplorer.Application")

'  ie.Navigate "about:Tabs"

'  ie.Visible = True

Set shts = ActiveSheet '  Sheets("工作表2")

shts.Cells.Clear

URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"

With CreateObject("InternetExplorer.Application")

      .Visible = True    '  是否顯示 IE

      .Navigate URL



      Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop



      For Each x In .Document.getElementsBytagname("input")

         If x.Value = "查詢" Then x.Click: Exit For

      Next



      Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop



      Set A = .Document.getElementsBytagname("table")

      For x = 1 To 6

         '  With ie

            .Document.body.innerHTML = A(x).outerHTML

            .ExecWB 17, 2    '  Select All

            .ExecWB 12, 2    '  Copy selection

         '  End With



         With shts

            .Range("A" & .[A65535].End(xlUp).Row + 1).Select

            .PasteSpecial Format:="HTML"

         End With

      Next



      shts.Cells.EntireColumn.AutoFit    '  自動調整欄寬

      .Quit

End With

'  ie.Quit

End Sub
複製代碼
[attach]16828[/attach]
作者: c_c_lai 時間: 2013-11-22 06:56

回復 60# GBKEE
我原本的測試程式碼：
Sub 鉅享網3()

Dim URL As String, shts As Worksheet

Dim x As Variant, xi As Integer

Set shts = ActiveSheet       '  Sheets("工作表2")

URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"

With CreateObject("InternetExplorer.Application")

      .Visible = True    '  是否顯示 IE

      .Navigate URL



      Do While .ReadyState <> 4 Or .Busy

         DoEvents

      Loop



      For Each x In .Document.getElementsBytagname("input")

         If x.Value = "查詢" Then x.Click: Exit For

      Next



      shts.Cells.Clear

      For xi = 1 To 6

         '  .document.body.innerHTML = .document.getElementsBytagname("table")(1).outerHTML

         .Document.body.innerHTML = .Document.getElementsBytagname("table")(xi).outerHTML

         .ExecWB 17, 2    '  Select All

         .ExecWB 12, 2    '  Copy selection



         With shts

            '  .Cells.Clear

            .Range("A" & .[A65535].End(xlUp).Row + 1).Select

            .PasteSpecial Format:="HTML"

            '  .Cells.EntireColumn.AutoFit    '  自動調整欄寬

         End With

      Next xi

      shts.Cells.EntireColumn.AutoFit    '  自動調整欄寬



      .Quit

End With

End Sub
複製代碼
[attach]16829[/attach]
作者: GBKEE 時間: 2013-11-22 07:15

本帖最後由 GBKEE 於 2013-11-22 07:16 編輯

回復 64# c_c_lai
在2003也是有這錯誤,經儲存內容再還原,就沒有這錯誤.
Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop

      xlHtm = .Document.body.innerHTML             '儲存

      Set A = .Document.getElementsBytagname("table")

      For xi = 1 To 6

         .Document.body.innerHTML = A(xi).outerHTML

         .ExecWB 17, 2    '  Select All

         .ExecWB 12, 2    '  Copy selection

         With shts

            .Range("A" & .[A65535].End(xlUp).Row + 1).Select

            .PasteSpecial Format:="HTML"

         End With

         .Document.body.innerHTML = xlHtm                '還原

      Next xi
複製代碼
之後在為了不儲存再還原. 才有56#的程式碼在空白網頁放置 "table"的寫法
作者: c_c_lai 時間: 2013-11-22 07:24

本帖最後由 c_c_lai 於 2013-11-22 07:36 編輯

回復 60# GBKEE
(圖中與54# 的程式碼有點不樣)
附上執行之程式碼：
Sub 鉅享網4()

Dim URL As String, shts As Worksheet

Dim x As Variant, xi As Integer, A As Object, xlHtm

Set shts = ActiveSheet '  '("工作表2")

shts.Cells.Clear

URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"

With CreateObject("InternetExplorer.Application")

      .Visible = True    '  是否顯示 IE

      .Navigate URL

      Do While .ReadyState <> 4 Or .Busy

            DoEvents

         Loop

      For Each x In .Document.getElementsBytagname("input")

         If x.Value = "查詢" Then x.Click: Exit For

      Next

      Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop

      xlHtm = .Document.body.innerHTML             '儲存

      Set A = .Document.getElementsBytagname("table")

      For xi = 1 To 6

         .Document.body.innerHTML = A(xi).outerHTML

         .ExecWB 17, 2    '  Select All

         .ExecWB 12, 2    '  Copy selection

         With shts

            .Range("A" & .[A65535].End(xlUp).Row + 1).Select

            .PasteSpecial Format:="HTML"

         End With

         .Document.body.innerHTML = xlHtm                '還原

      Next xi

      shts.Cells.EntireColumn.AutoFit    '  自動調整欄寬

      .Quit

End With

End Sub
複製代碼
[attach]16831[/attach]
P.S.    這是剛才才執行出來的決果。
作者: c_c_lai 時間: 2013-11-22 07:34

回復 65# GBKEE
(56#的程式碼在空白網頁放置 "table"的寫法)
我將 "空白網頁" 隱藏起來視覺上清爽多了。
Set ie = CreateObject("InternetExplorer.Application")

ie.Navigate "about:Tabs"

'  ie.Visible = True
複製代碼
執行決果一切 OK。
作者: GBKEE 時間: 2013-11-22 07:42

本帖最後由 GBKEE 於 2013-11-22 07:44 編輯

回復 67# c_c_lai
66# 說的錯誤,2003沒有發生.
2個ie都可以不顯示,那更清爽的.
作者: c_c_lai 時間: 2013-11-22 07:48

回復 68# GBKEE
說的也是！
謝謝指導。
作者: c_c_lai 時間: 2013-11-22 08:03

回復 68# GBKEE
事後想想，發覺利用 "空白網頁" 來做為臨時戰場  (進行複製工作)，
這個 Idea 蠻好的，亦不會破壞原本網頁的 Table 內容。
      Set A = .Document.getElementsBytagname("table")

      For x = 1 To 6

         With ie

            .Document.body.innerHTML = A(x).outerHTML

            .ExecWB 17, 2    '  Select All

            .ExecWB 12, 2    '  Copy selection

         End With



         With shts

            .Range("A" & .[A65535].End(xlUp).Row + 1).Select

            .PasteSpecial Format:="HTML"

         End With

      Next
複製代碼
作者: c_c_lai 時間: 2013-11-22 08:17

回復 68# GBKEE
哈哈！
太清爽了也不行！ (只能第一個 "空白網頁")
[attach]16833[/attach]
作者: GBKEE 時間: 2013-11-22 08:33

回復 71# c_c_lai
2個IE都不顯示,2003再跑一次,OK!
作者: c_c_lai 時間: 2013-11-22 08:44

回復 72# GBKEE
所以說嘛，這就是我之所以佩服 Micrsoft 的地方！
不得不服氣。
作者: c_c_lai 時間: 2013-11-22 09:01

回復 72# GBKEE
不信邪再試一次 (Marked 後先儲存一次，再行執行)。
事後只出現過一次"權限問題"後，一切又歸於平靜 (正常了)。
這便是我佩服 Microsoft 的緣故。
作者: c_c_lai 時間: 2013-11-22 09:04

回復 72# GBKEE
Set ie = CreateObject("InternetExplorer.Application")

ie.Navigate "about:Tabs"

'  ie.Visible = True

Set shts = ActiveSheet '  Sheets("工作表2")

shts.Cells.Clear

URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"

With CreateObject("InternetExplorer.Application")

      '  .Visible = True    '  是否顯示 IE

      .Navigate URL


複製代碼
作者: gable 時間: 2013-12-7 02:16

新手剛加入學習了
謝謝大大們 ^^
作者: 活力充沛 時間: 2014-1-21 21:02

積分還不夠><"
可下載"查找標籤.zip" 的大大,可否傳給小弟!

E-mail: [email protected]
感激不敬~

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