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

帖子: 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無法控制

With Sheet1
.Range("A1:A3").Value = .Range("C1:C3").Value '啟動系統自動更新資料
End With

複製代碼

帖子: 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~

帖子: 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的程式碼

Sub Ex()
Dim i As Integer, Test() As New Class1
'Test指定為新物件類別模組 : Class1物件
On Error Resume Next
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

複製代碼

帖子: 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~

帖子: 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

Sub Ex1()
Dim t As Date
t = Time
On Error Resume Next
With Sheet1
.Range("A1:A3").Value = .Range("C1:C3").Value
End With
With Sheet2
.Cells.Interior.ColorIndex = xlNone
For I = 1 To .QueryTables.Count
Err.Clear
.QueryTables(I).Refresh False
If Err.Number > 0 Then 'Web查詢失敗
With .QueryTables(I).ResultRange
.Interior.ColorIndex = 37
.Cells(1).Offset(1).Resize(.Rows.Count - 1, .Columns.Count) = "查無資料"
End With
End If
Next I
End With
End Sub

複製代碼

帖子: 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~

帖子: 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
試試看

Sub Ex()
Dim t As Date
t = Time
On Error Resume Next
1:
Sheet1.QueryTables(1).Refresh False
Debug.Print Err.Number '即時運算視窗查看 Err.Number
If Err.Number > 0 Then 'Web查詢失敗
If Time > t + #12:00:10 AM# Then '連線時間超過1分鐘
If MsgBox("連線時間超過1分鐘繼續Web查詢 ??", vbYesNo) = vbNo Then Exit Sub
t = Time
End If
GoTo 1
End If
End Sub

複製代碼

Sub Ex1()
Dim t As Date
t = Time
On Error Resume Next
Do
Err.Clear
Sheet1.QueryTables(1).Refresh False
If Err.Number > 0 Then 'Web查詢失敗
If Time > t + #12:00:10 AM# Then '連線時間超過1分鐘
If MsgBox("連線時間超過1分鐘繼續Web查詢 ??", vbYesNo) = vbNo Then Exit Sub
t = Time
End If
End If
Loop While Err.Number > 0
End Sub

複製代碼

帖子: 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~

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2025-7-5

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