12
返回列表 上一主題 發帖

(發問)WEB查詢，如何取消跳出的警告視窗

jewayy

帖子
36 
主題
9 
精華
0 
積分
51 
點名
0  
作業系統
Win7 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
註冊時間
2011-10-30 
最後登錄
2015-1-31 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-10-31 00:02 | 只看該作者

(發問)WEB查詢，如何取消跳出的警告視窗

各位先進，小弟有使用WEB查詢網頁資料，但常常會因為網路連線不良，出現以下訊息：

"此WEB查詢沒有傳回資料，要修改查詢，按[確定]，按資料編輯列上的名稱方塊中的外部資料範圍，然後按[外部資料]工具列上的[編輯查詢]。"

必須將這訊息點掉，才能繼續更新WEB查詢的資料，常常程式跑一半卡住，非常困擾。
有試過Application.DisplayAlerts = False 或 Application.EnableEvents = false或On error resume  next
不過都沒有用，請各位先進指點一下，感激不盡。
收藏 分享

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
2#
發表於 2011-10-31 23:18 | 只看該作者
回復 1# jewayy
你可以於錯誤發生時將程式導向錯誤處理程序,
於 錯誤處理程序 開頭事先先加上中斷,
再於其中顯示出錯誤代碼,
最後將該代碼的處理程序加入即可.
  Sub Test()  
  On Error GoTo ErrorFix
  exit Sub

ErrorFix:
  MsgBox Err.Number
  MsgBox Err.Description
If Err.Number = 11 Then
.
.
    Err.Clear
  End If
  Resume
End Sub

TOP

jewayy

帖子
36 
主題
9 
精華
0 
積分
51 
點名
0  
作業系統
Win7 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
註冊時間
2011-10-30 
最後登錄
2015-1-31 
3#
發表於 2011-11-1 00:37 | 只看該作者
謝謝您的回覆。
不過就是程式抓不到Error,否則用On Error Resume  Next就有用了。
因此有嘗試過您的方法，就是跳不到ErrorFix,因此就沒辦法用Err.Number來處理了。
所以此錯誤"此WEB查詢沒有傳回資料，要修改查詢，按[確定]，按資料編輯列上的名稱方塊中的外部資料範圍，然後按[外部資料]工具列上的[編輯查詢]。"還是繼續產生，無法消除。
請問還有其他idea嗎？還是非常謝謝您撥冗回覆~~
Hi~

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2011-11-1 08:27 | 只看該作者
本帖最後由 GBKEE 於 2011-11-1 12:59 編輯

回復 3# jewayy
試試看
  1. Sub Ex()
  2. Dim t As Date
  3.     t = Time
  4.     On Error Resume Next
  5. 1:
  6.     Sheet1.QueryTables(1).Refresh False
  7.     Debug.Print Err.Number                 '即時運算視窗查看 Err.Number
  8.     If Err.Number > 0 Then                 'Web查詢 失敗
  9.         If Time > t + #12:00:10 AM# Then   '連線時間超過1分鐘
  10.             If MsgBox("連線時間超過1分鐘 繼續Web查詢 ??", vbYesNo) = vbNo Then Exit Sub
  11.             t = Time
  12.         End If
  13.         GoTo 1
  14.     End If
  15. End Sub
複製代碼
  1. Sub Ex1()
  2.     Dim t As Date
  3.     t = Time
  4.     On Error Resume Next
  5.     Do
  6.         Err.Clear
  7.         Sheet1.QueryTables(1).Refresh False
  8.         If Err.Number > 0 Then                 'Web查詢 失敗
  9.             If Time > t + #12:00:10 AM# Then   '連線時間超過1分鐘
  10.                 If MsgBox("連線時間超過1分鐘 繼續Web查詢 ??", vbYesNo) = vbNo Then Exit Sub
  11.                 t = Time
  12.             End If
  13.         End If
  14.     Loop While Err.Number > 0
  15. End Sub
複製代碼

TOP

jewayy

帖子
36 
主題
9 
精華
0 
積分
51 
點名
0  
作業系統
Win7 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
註冊時間
2011-10-30 
最後登錄
2015-1-31 
5#
發表於 2011-11-15 23:43 | 只看該作者
謝謝您的回覆，已經試了您的寫法，還是沒有辦法抓到錯誤視窗的事件來處理。
附上檔案好了。
Sheet2的資料會隨著Sheet1的A1~A3來做WEB查詢變動，因此設計C1~C3 copy過去改變A1~A3時進行WEB查詢。
C2的數值70645291是故意設計查詢不到的，想藉此練習碰到警告視窗要如何處理，請先進指點一下，感謝~

Book1.rar (8.81 KB)

    Sub Ex2()
        Dim t As Date
        t = Time
        On Error Resume Next
        
    Worksheets("Sheet1").Activate
    Range("A1:A3").Value = Range("C1:C3").Value
        
        Do
            Err.Clear
            Sheet1.QueryTables(1).Refresh False
            If Err.Number > 0 Then                 'Web查詢 失敗
                GoTo J:
            End If
        Loop While Err.Number > 0

J:

    MsgBox "Game over"
   
    End Sub
Hi~

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2011-11-16 07:38 | 只看該作者
回復 5# jewayy
  1. Sub Ex1()
  2.     Dim t As Date
  3.     t = Time
  4.     On Error Resume Next
  5.     With Sheet1
  6.         .Range("A1:A3").Value = .Range("C1:C3").Value
  7.     End With
  8.     With Sheet2
  9.         .Cells.Interior.ColorIndex = xlNone
  10.         For I = 1 To .QueryTables.Count
  11.             Err.Clear
  12.             .QueryTables(I).Refresh False
  13.             If Err.Number > 0 Then                 'Web查詢 失敗
  14.                 With .QueryTables(I).ResultRange
  15.                     .Interior.ColorIndex = 37
  16.                     .Cells(1).Offset(1).Resize(.Rows.Count - 1, .Columns.Count) = "查無資料"
  17.                 End With
  18.             End If
  19.         Next I
  20.     End With
  21. End Sub
複製代碼

TOP

jewayy

帖子
36 
主題
9 
精華
0 
積分
51 
點名
0  
作業系統
Win7 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
註冊時間
2011-10-30 
最後登錄
2015-1-31 
7#
發表於 2011-11-16 21:29 | 只看該作者
謝謝先進GBKEE版主指點迷津，現在才知道Querytables的用法，真的很受用。
不過，還是會跳出
"此WEB查詢沒有傳回資料，要修改查詢，按[確定]......."等的訊息
必須將這訊息點掉，才能繼續更新WEB查詢的資料，常常程式跑一半卡住，非常困擾。
再次斗膽請教，有方法讓這訊息不要跳出來嗎？
Hi~

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2011-11-17 07:55 | 只看該作者
本帖最後由 GBKEE 於 2011-11-17 08:05 編輯

回復 7# jewayy
奇怪 測試沒問題的, 怎又出現 ,請改用物件類別模組.
請在 VAB中插入一 物件類別模組  會自動名為 Class1
執行 Ex
Module1的程式碼
  1. Sub Ex()
  2.     Dim i As Integer, Test() As New Class1
  3.     'Test指定為 新物件類別模組 :  Class1物件
  4.     On Error Resume Next
  5.     For i = 1 To Sheet2.QueryTables.Count
  6.         ReDim Preserve Test(1 To i)
  7.         Set Test(i).Query = Sheet2.QueryTables(i)
  8.         Test(i).Query.Refresh False
  9.     Next
  10. End Sub
複製代碼
物件類別模組   : Class1 的程式碼
  1. Option Explicit
  2. Public WithEvents Query As QueryTable    'Query指定為QueryTable物件
  3. Private Sub Query_AfterRefresh(ByVal Success As Boolean)   '查詢後的事件
  4.   If Success = False Then    '查詢失敗   'Success = True   查詢成功
  5.         With Query.ResultRange
  6.             .Interior.ColorIndex = 37
  7.             .Cells(1).Offset(1).Resize(.Rows.Count - 1, .Columns.Count) = "查無資料"
  8.         End With
  9.   End If
  10. End Sub
  11. Private Sub Query_BeforeRefresh(Cancel As Boolean)  '查詢前的事件
  12.     With Query.ResultRange
  13.             .Interior.ColorIndex = xlNone
  14.     End With
  15. End Sub
複製代碼

TOP

jewayy

帖子
36 
主題
9 
精華
0 
積分
51 
點名
0  
作業系統
Win7 
軟體版本
Office2003 
閱讀權限
20 
性別
男 
註冊時間
2011-10-30 
最後登錄
2015-1-31 
9#
發表於 2011-11-17 16:45 | 只看該作者
謝謝您用心指導，在Module1執行Ex.
不知道我這樣寫對不對，請幫我確認，因為警告訊息還是會跑出來，哈哈。
附上檔案供您參考~ Book2.rar (12.47 KB)

模組Module1
    Sub Ex()
        Dim i As Integer, Test() As New Class1
        'Test指定為 新物件類別模組 :  Class1物件
        On Error Resume Next
        
        With Sheet1
            .Range("A1:A3").Value = .Range("C1:C3").Value
        End With
   
        For i = 1 To Sheet2.QueryTables.Count
            ReDim Preserve Test(1 To i)
            Set Test(i).Query = Sheet2.QueryTables(i)
            Test(i).Query.Refresh False
        Next
    End Sub

物件類別模式 Class1
   Option Explicit
    Public WithEvents Query As QueryTable    'Query指定為QueryTable物件
    Private Sub Query_AfterRefresh(ByVal Success As Boolean)   '查詢後的事件
      
      If Success = False Then    '查詢失敗   'Success = True   查詢成功
            With Query.ResultRange
                .Interior.ColorIndex = 37
                .Cells(1).Offset(1).Resize(.Rows.Count - 1, .Columns.Count) = "查無資料"
            End With
      End If
    End Sub
   
    Private Sub Query_BeforeRefresh(Cancel As Boolean)  '查詢前的事件
        With Query.ResultRange
                .Interior.ColorIndex = xlNone
        End With
    End Sub
Hi~

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2011-11-17 17:37 | 只看該作者
回復 9# jewayy
沒辦法解決    你的 Web查詢 設定參數 變動   系統  自動更新資料    VBA無法控制   
   
  1. With Sheet1
  2.             .Range("A1:A3").Value = .Range("C1:C3").Value    '啟動 系統  自動更新資料
  3.         End With
複製代碼

TOP

        靜思自在 : 人要知福、惜福、再造福。
12
返回列表 上一主題