VBA可以測試網路有連線嗎? VBA網頁

algoji3ji3

DEAR 各大大
以下是我的程式碼
網路連線時可以正常使用~
但是網路沒接時~會出現錯誤~
請問可以在前面做偵測網路有無連線的方式嗎?

1. Sub 下載()    '網頁下載
   
2. 
   
3.         Const url As String = "https://www.1keydata.com/tw/sql/sql.html"     ' 正確的
   
4. 
   
5.         Cells.Clear
   
6. 
   
7.         Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
   
8. 
   
9.         With ie
   
10.             .Visible = False 'True為開啟ie, False為不開啟ie
    
11.             .navigate url
    
12.             Do While .readyState <> 4 '等待網頁開啟
    
13.             DoEvents
    
14.             Loop
    
15.             .ExecWB 17, 2 'Select All
    
16.             .ExecWB 12, 2 'Copy selection
    
17.             Range("A1").Activate
    
18.             ActiveSheet.PasteSpecial Format:="HTML", link:=False, DisplayAsIcon:= _
    
19.                 False, NoHTMLFormatting:=True
    
20.         End With
    
21. 
    
22.         ie.Quit
    
23.         MsgBox "資料複製結束"    ' 離開前顯示一小視窗提醒，按它後即結束。
    
24. End Sub

複製代碼

jackyq

簡法
連1下 google
上不去就代表沒連線

c_c_lai

回復 1# algoji3ji3

下載 (30.69 KB)

2016-6-13 11:22

algoji3ji3

回復 3# c_c_lai

目前可以正常連線沒錯~
我是想只說如果今天網路異常時~
怎麼判定網頁如果開不起來就跳過程式呢?

c_c_lai

回復 4# algoji3ji3
參考一下:
避免程式被不可預期的錯誤所中斷，就應該使用
on error goto label_name
on error goto 0
on error resume next
來防止。以上述敘使用的有效範圍為 Sub 或 Function，
例如在 Sub 或 Function 的開頭加上
則在 Sub 或 Function 結束就功能失效，
或者使用 on error goto 0 來取消功能。
若發生的錯誤都是可忽略的，建議使用
on error resume next
如此程式就不會因為不可預期的錯誤所中斷了。
如果能知道錯誤的原因，每個錯誤都有個代號
在 Err 物件中，可由 Err.Number 來取得
如果錯誤原因有很多種，則可以用
on error goto label_name 來攔截錯誤。

GBKEE

回復 4# algoji3ji3

試試看

1. Option Explicit
   
2. Sub 下載()    '網頁下載
   
3.        ' Dim ie As Object
   
4.         Const url As String = "https://www.1keydata.com/tw/sql/sql.html"     ' 正確的
   
5.         Cells.Clear
   
6. Re:
   
7.        ' Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
   
8.         With CreateObject("internetexplorer.application")
   
9.            ' .Visible = False 'True為開啟ie, False為不開啟ie
   
10.            .Visible = 1
    
11.             .navigate url
    
12.             Do While .busy Or .readyState <> 4 '等待網頁開啟
    
13.             DoEvents
    
14.             Loop
    
15.             If .DOCUMENT.Title = "Internet Explorer 無法顯示網頁" Then
    
16.                 '如網路沒有連線時, IE的表頭="Internet Explorer 無法顯示網頁"                '
    
17.                 .Quit
    
18.                 Adsl連線
    
19.                 GoTo Re
    
20.             End If
    
21.             .ExecWB 17, 2 'Select All
    
22.             .ExecWB 12, 2 'Copy selection
    
23.             Range("A1").Activate
    
24.             ActiveSheet.PasteSpecial Format:="HTML", link:=False, DisplayAsIcon:= _
    
25.                 False, NoHTMLFormatting:=True
    
26.             .Quit
    
27.         End With
    
28.         MsgBox "資料複製結束"    ' 離開前顯示一小視窗提醒，按它後即結束。
    
29. End Sub

複製代碼

1. Sub Adsl連線()
   
2.     Dim fs As Object, xBat As String, xAdsl As String
   
3.      xBat = "d:\Adsl.BAT"
   
4.      xAdsl = "d:\xAdsl.txt"
   
5.     Set fs = CreateObject("Scripting.FileSystemObject")
   
6.     With fs.CreateTextFile(xBat, 1)            '建立一個檔案
   
7.         .Write "rasdial /disconnect" & vbCrLf
   
8.         '********************************************************
   
9.         .Write "rasdial MyAdsl xxxxx@hinet.net 123456789 >> " & xAdsl & vbCrLf
   
10.         '   需輸數 入正確的 Pc連線名稱 連線帳戶 密碼  ****
    
11.         .Write "rasdial Pc連線名稱 連線帳戶 密碼 >> " & xAdsl & vbCrLf
    
12.         '********************************************************
    
13.         .Write "DEL d:\xAdsl.txt" & vbCrLf
    
14.         .Close
    
15.     End With
    
16.     Shell (xBat)              '
    
17.     Do While Dir(xAdsl) = "": DoEvents: Loop
    
18.     Do While Dir(xAdsl) <> "": DoEvents: Loop
    
19.     Kill xBat
    
20. End Sub

複製代碼

algoji3ji3

回復 6# GBKEE

感謝版主大大幫忙~~
稍微修改了一下~斷線時可以跳過程序~不再當機了~

1. Sub 下載()    '網頁下載
   
2.        ' Dim ie As Object
   
3.         Const url As String = "https://www.1keydata.com/tw/sql/sql.html"     ' 正確的
   
4.         Cells.Clear
   
5. 
   
6.        ' Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
   
7.         With CreateObject("internetexplorer.application")
   
8.            .Visible = False 'True為開啟ie, False為不開啟ie
   
9.            '.Visible = 1
   
10.             .navigate url
    
11.             Do While .Busy Or .readyState <> 4 '等待網頁開啟
    
12.             DoEvents
    
13.             Loop
    
14.             If .Document.Title = "您尚未連線到網路" Then
    
15.                 '如網路沒有連線時, IE的表頭="Internet Explorer 無法顯示網頁"                '
    
16.                 .Quit
    
17.                 MsgBox "您尚未連接到網路，請檢查網路狀態後再試一次"    ' 離開前顯示一小視窗提醒，按它後即結束。
    
18.                 GoTo Re
    
19.             End If
    
20.             .ExecWB 17, 2 'Select All
    
21.             .ExecWB 12, 2 'Copy selection
    
22.             Range("A1").Activate
    
23.             ActiveSheet.PasteSpecial Format:="HTML", link:=False, DisplayAsIcon:= _
    
24.                 False, NoHTMLFormatting:=True
    
25.             .Quit
    
26.         MsgBox "資料複製結束"    ' 離開前顯示一小視窗提醒，按它後即結束。
    
27.         End With
    
28. Re:
    
29. End Sub

複製代碼