12
返回列表 上一主題 發帖

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

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
11# 跳轉到 »
發表於 2014-2-22 09:39 | 只看該作者
本帖最後由 blue2263 於 2014-2-22 09:42 編輯

請教G大我的也有相同問題?可否幫我看一下,也會出現,web查詢沒有傳回資料訊息
程式碼停止,出現訊息的代號在A1499(儲存格),我測試發現一個奇怪的現象.如果把下列程式碼位置,設在A1456會出現錯誤訊息
把位置設在A1497,狀態就正常,錯誤訊息就不會跳出
請教不知有何方法,可解決這問題? A.rar (81.8 KB)

程式碼同下.........
Sub 資料下載整合()
    '資料網路下載->匯總Sheets
    Dim Rng As Range, Ar(1 To 3)
    Set Rng = Sheets("代碼").[a1456] '代碼起始位置在a2
    Do While Rng <> ""   '無代碼 中斷

        With Sheets("原始表")
             .Range("a6") = Rng
             On Error GoTo 101 '   'web 查無 到下一個代碼
             .Range("az7").QueryTable.Refresh BackgroundQuery:=False
            With .Range("BB12:BB27")
                    Ar(1) = Application.Transpose(.Cells)         '人數
                    Ar(2) = Application.Transpose(.Offset(, 1))   '股數
                    Ar(3) = Application.Transpose(.Offset(, 2))   '佔集保庫存數比例 (%)
            End With
        End With
        With Sheets("匯總").Range("A1").End(xlDown).Offset(1) '選擇工作表,到最底行
             .Cells(1) = Rng
             .Cells(1, 2) = Rng.Offset(, 1)
             .Cells(1, "C").Resize(, UBound(Ar(1))) = Ar(1)
             .Cells(1, "S").Resize(, UBound(Ar(1))) = Ar(2)
             .Cells(1, "AI").Resize(, UBound(Ar(1))) = Ar(3)
             .Cells(1, "AX") = ""
            '.Range("A1:aw1").Value = Sheets("原始表").Range("A6:aw6").Value

         End With
101
         Set Rng = Rng.Offset(1)   '下一個代碼
    Loop
End Sub

C股權分散.rar (81.8 KB)

TOP

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
12#
發表於 2014-2-23 12:23 | 只看該作者
回復 11# blue2263
股權分散的網頁，查不到資料會跳出視窗

win7會有些問題

我用是用xmlhttp下載來看的，只要網頁在本地端，就不會有連線問題

即使是彈跳視窗，在網頁中，查一下html body 就有相關的字句，自然可以跳過，如果不這樣用，也可以下載後用查檢網頁大小就知道有資料與查無資料的網頁大小是不一樣的

以上

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
13#
發表於 2014-2-24 23:36 | 只看該作者
本帖最後由 blue2263 於 2014-2-24 23:47 編輯

謝謝j大解答
我將程式碼改為,On Error Resume Next
然後加一IF判斷,判斷資料無更改,就跳開,測試
看起來是沒問題,錯誤訊息不會跑出,且跳出,
我是新手,不知我這樣改,會不會有什麼問題?
還請指教謝謝!!

程式碼如下

Sub 資料下載整合()
    '資料網路下載->匯總Sheets
       Dim Rng As Range, Ar(1 To 3)
       Dim err
    Set Rng = Sheets("代碼").[a2] '代碼起始位置在a2
    Do While Rng <> ""   '無代碼 中斷
       Dim myErrNum As Long

        With Sheets("原始表")
             .Range("a6") = Rng
             On Error Resume Next   '發生錯誤陳述式之後的陳述式繼續執行
             err = Sheets("原始表").Range("az7")
             .Range("az7").QueryTable.Refresh BackgroundQuery:=False
             On Error GoTo 0    '停止error resume
            If err = Sheets("原始表").Range("az7") Then GoTo 103
            With .Range("BB12:BB27")
                    Ar(1) = Application.Transpose(.Cells)         '人數
                    Ar(2) = Application.Transpose(.Offset(, 1))   '股數
                    Ar(3) = Application.Transpose(.Offset(, 2))   '佔集保庫存數比例 (%)
            End With
        End With
        With Sheets("匯總").Range("A1").End(xlDown).Offset(1) '選擇工作表,到最底行
             .Cells(1) = Rng
             .Cells(1, 2) = Rng.Offset(, 1)
             .Cells(1, "C").Resize(, UBound(Ar(1))) = Ar(1)
             .Cells(1, "S").Resize(, UBound(Ar(1))) = Ar(2)
             .Cells(1, "AI").Resize(, UBound(Ar(1))) = Ar(3)
             .Cells(1, "AX") = ""
            '.Range("A1:aw1").Value = Sheets("原始表").Range("A6:aw6").Value
         End With
103
         Set Rng = Rng.Offset(1)   '下一個代碼
         
    Loop
End Sub

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2014-2-25 16:50 | 只看該作者
回復 13# blue2263
以下是我的見解
  1.    On Error GoTo 101 '   'web 查無 到下一個代碼  
  2. ** 單一次的Refresh失敗 On Error GoTo 101 可以處理
  3. ** 但連續的Refresh失敗 On Error GoTo 101 無法處理(無解)
  4.              .Range("az7").QueryTable.Refresh BackgroundQuery:=False
  5. QueryTable.Refresh BackgroundQuery:=False           
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
15#
發表於 2014-2-26 05:29 | 只看該作者
感謝g大解答
原來連續的refresh失敗無法處理,難怪上次更改代碼開始位置,會一下正常,一下不正常

TOP

7777

帖子
125 
主題
33 
精華
0 
積分
223 
點名
0  
作業系統
XP 
軟體版本
Excel 2003 
閱讀權限
20 
性別
男 
來自
台北市 
註冊時間
2010-9-6 
最後登錄
2024-6-8 
16#
發表於 2018-8-9 15:42 | 只看該作者
回復 4# GBKEE


請教~GBKEE大大
我也有相同情形?可否幫忙協助一下

跳出 警示"視窗" ，
如何 自動關閉視窗，不影響下且 繼續巨集作業~~

巨集作業 是
某個網頁 每15秒更新一次
ActiveWorkbook.RefreshAll

有時會跳出視窗 "無法開啟  ........." 之視窗
可以加什麼
將 視窗
自動關閉視窗，不影響下且 繼續巨集作業~~

導入 4# 的內容，不勝了解
還請 大大 指點一下，感謝~



Sub 偵測()

On Error Resume Next
        Application.OnTime Now + TimeValue("00:00:15"), "偵測"
        ActiveWorkbook.RefreshAll

        'http://info512.taifex.com.tw/Future/VIXQuote_Norl.aspx
        '自動關閉視窗，不影響下且 繼續巨集作業~~

End Sub

還請 大大 指點一下，感謝~
50 字節以內
不支持自定義 Discuz! 代碼

TOP

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
17#
發表於 2018-8-9 21:07 | 只看該作者
回復 16# 7777


    試試看吧!
  1. Sub test()
  2.     Dim x
  3.     Dim oie As Object: Set oie = CreateObject("internetexplorer.application")
  4.     With oie
  5.         .Visible = True
  6.         .Navigate ""
  7.         Do While .readystate <> 4 Or .busy: DoEvents: Loop
  8. Set wshshell = CreateObject("wscript.shell")

  10. Do
  11.     ret = wshshell.AppActivate("Microsoft Excel")
  12. Loop Until ret = True

  14.     Application.Wait Now + 2 / 86400
  15.     ret = wshshell.AppActivate("Microsoft Excel")
  16.         If ret = True Then
  17.                    ret = wshshell.AppActivate("Microsoft Excel")
  18.                 Application.Wait Now + 2 / 86400
  19.                 wshshell.SendKeys "{enter}"
  20.         End If
  21.         Application.Wait Now + 2 / 86400
  22.         Do While .readystate <> 4 Or .busy: DoEvents: Loop
  23.         .Quit
  24.     End With
  25. End Sub
複製代碼
一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

7777

帖子
125 
主題
33 
精華
0 
積分
223 
點名
0  
作業系統
XP 
軟體版本
Excel 2003 
閱讀權限
20 
性別
男 
來自
台北市 
註冊時間
2010-9-6 
最後登錄
2024-6-8 
18#
發表於 2018-8-14 16:11 | 只看該作者
回復 17# faye59

faye59大大  感謝你 撥冗協助
<<試試看吧!>> 好像很簡單
不懂下，不敢隨便發問，
就還是先..爬了爬文，試了試 （2天）...... 還是不懂

我該 如何.... 溶入原先的  Sub 偵測() 內

Sub test()
    Dim x   
    Dim oie As Object: Set oie = CreateObject("internetexplorer.application")
    With oie
        .Visible = True   '我 要改 False 不顯示 表現
        .Navigate ""       ' 這是 要放網址嗎??  如有 3個 網址...的話  該???
        Do While .readystate <> 4 Or .busy: DoEvents: Loop
Set wshshell = CreateObject("wscript.shell")

Do
    ret = wshshell.AppActivate("Microsoft Excel")
Loop Until ret = True

    Application.Wait Now + 2 / 86400    '等待 2秒
    ret = wshshell.AppActivate("Microsoft Excel")
        If ret = True Then
                   ret = wshshell.AppActivate("Microsoft Excel")
                Application.Wait Now + 2 / 86400
                wshshell.SendKeys "{enter}"
        End If
        Application.Wait Now + 2 / 86400
        Do While .readystate <> 4 Or .busy: DoEvents: Loop
        .Quit
    End With
End Sub

請  faye59大大 幫忙  感謝!
50 字節以內
不支持自定義 Discuz! 代碼

TOP

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
19#
發表於 2018-8-16 21:10 | 只看該作者
回復 18# 7777


    網址3個的話要看你讀取順序，猜你應該都是分批讀取吧，只要在網址地方改成字串再用迴圈方式重複這段程序即可，
或是你可以附上你的最新進度檔案，這樣比較清楚你的問題點。
其實這段程序只是讓你測試用，從第7列開始才是重點。
  1. Sub test()
  2.     Dim oie As Object: Set oie = CreateObject("internetexplorer.application")
  3.     With oie
  4.         '.Visible = True '這部分註解掉也沒關係，註解掉不會顯示背景還是會執行跟False一樣，因為測試所以需開啟畫面確認後續程序無誤
  5.         .Navigate "" '輸入網址
  6.         Do While .readystate <> 4 Or .busy: DoEvents: Loop
  7. Set wshshell = CreateObject("wscript.shell") '引用其它物件，呼叫其它應用程式

  9. Do '迴圈應用程式中指定物件
  10.     ret = wshshell.AppActivate("Microsoft Excel") '找尋引用物件名稱，如果跳出視窗標題是"網頁訊息"修改成警告訊息標題
  11.     '陳述式AppActivate標題 [等待]
  12. Loop Until ret = True '當ret有值時結束迴圈

  14.     Application.Wait Now + 2 / 86400 '這部分其實可以不等待
  15.     ret = wshshell.AppActivate("Microsoft Excel")
  16.         If ret = True Then
  17.                    ret = wshshell.AppActivate("Microsoft Excel")
  18.                 Application.Wait Now + 2 / 86400 '這裡一定要等待2秒，其實時間不一定，只是SendKeys這個動作常常發生不穩定性問題，確保程序沒問題才執行enter這動作
  19.                 wshshell.SendKeys "{enter}" '對警告訊息視窗按下鍵盤enter按鍵
  20.         End If
  21.         Application.Wait Now + 2 / 86400 '等待2秒
  22.         Do While .readystate <> 4 Or .busy: DoEvents: Loop '確認網頁載入完成
  23.         .Quit '關閉網頁
  24.     End With
  25. End Sub
複製代碼
以上是我以前從麻辣家族某個地方Copy過來的(忘記來源了...抱歉)，我實際用上是針對會跳出警告視窗地方加入以下程序即可。
  1. Set Wshshell = CreateObject("wscript.shell")'新增Wshshell為呼叫其它應用程式物件
  2. Application.Wait Now + 2 / 86400'等待2秒
  3. ret = Wshshell.AppActivate("網頁訊息")'ret應用程式中是否有"網頁訊息"Title
  4. If ret = True Then'確認有執行
  5. Wshshell.SendKeys "{enter}"'鍵盤操作enter指令
  6. End If
複製代碼
一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

7777

帖子
125 
主題
33 
精華
0 
積分
223 
點名
0  
作業系統
XP 
軟體版本
Excel 2003 
閱讀權限
20 
性別
男 
來自
台北市 
註冊時間
2010-9-6 
最後登錄
2024-6-8 
20#
發表於 2018-8-20 20:53 | 只看該作者
回復 19# faye59

感謝
faye59大大
這麼細心的解答指導...
讓我學習不少,解惑問題
謝謝!!
   
小弟 有附檔...   test1.rar (12.31 KB)
再請教
感謝
50 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
12
返回列表 上一主題