求使用vba ping

loveinput

Dears
想請問我一次有多筆資料需要ping格式如下：
台北        10.1.1.1                10.1.1.2                10.1.1.3       
台中        10.2.1.1                10.2.1.2                10.2.1.3
並需要在各個IP隔一欄去回覆ping是否正確，請問該怎麼 去寫?!

c_c_lai

回復 1# loveinput
麻辣網站上有豐富的資訊可供查詢與進修。
你的提問可以去參考：
測試IP

loveinput

各位先進
想請問我有一個ping的程式了，目前只能一個for迴圈結束後
才能繼續執行另一個迴圈，但是希望能同時執行兩個迴圈!!
已翻過討論區與google了，還是不了解該怎麼解或該將doevents加在那

再請指教
pinguse.zip (789 Bytes)

下載次數: 13

2014-1-4 17:28

loveinput

更新附件為excel
upping.zip (83.77 KB)

下載次數: 12

2014-1-6 15:48

GBKEE

回復 4# loveinput

1. Sub ipchange()
   
2. Dim rng, arr, i%, m% '宣告四個變數
   
3. rng = Range(Sheets("外部資料").[a1], Sheets("外部資料").[a65536].End(xlUp))   '變數值=欄位a1~a65536中的所有有值資料
   
4. '*** rng: 外部資料").[a1]以下沒有資料
   
5. rng2 = Range(Sheets("來源資料").[a1], Sheets("來源資料").[c65536].End(xlUp))   '變數值=欄位a1~a65536中的所有有值資料
   
6. '*** rng2這變數設定之後再也沒有用到,為何??
   
7. ReDim arr(1 To UBound(rng), 1 To 20)     '修改二維陣列大小MsgBox Val(rng)
   
8. '*** UBound(rng) 錯誤-> rng: 外部資料").[a1]以下沒有資料
   
9. For i = 1 To UBound(rng) - 1 Step 1
   
10. m = m + 1
    
11. '*** Sheets("來源資料").[h30] 沒有資料, Terminal IP 的程式碼錯誤
    
12. 'Terminal IP
    
13. If Range(Sheets("來源資料").[e1], Sheets("來源資料").[h30]).Find(Val(Split(rng(i + 1, 1), ".")(1))).Column = 5 And IsOdd(Val(Split(rng(i + 1, 1), ".")(3))) Then
    
14. arr(m, 3) = Split(rng(i + 1, 1), ".")(0) & "." & Split(rng(i + 1, 1), ".")(1) + 10 & "." & Split(rng(i + 1, 1), ".")(2) & "." & Split(rng(i + 1, 1), ".")(3) + 1

複製代碼

loveinput

謝謝GBKEE的回覆，可能我沒說清楚，我主要是執行ping1~ping7的動作，希望能同時執行!!
再肯請指教!!

GBKEE

回復 6# loveinput
Sub ipchange() 不能正常執行, 奢談我主要是執行ping1~ping7的動作，希望能同時執行!!

loveinput

upping.zip (83.88 KB)

下載次數: 7

2014-1-7 20:30

果真是奢談阿!!還望指導，更新如附件

GBKEE

回復 8# loveinput
同時跑兩個程式! (程式執行時,移動滑鼠,鍵盤,易出錯)

1. Option Explicit
   
2. Sub Ex_Ping()
   
3.     Dim AR(), Rng As Range, R As Integer, C As Integer, termPing As Object, termStatus As Variant
   
4.     With Worksheets("Sheet1")
   
5.         Set Rng = .Range("C2", .Range("C2").End(xlDown)).Resize(, .Range("C1").End(xlToRight).Column - 2)
   
6.         AR = Rng                                '轉入陣列
   
7.     End With
   
8.     For R = 1 To UBound(AR)                     '陣列:第一維(列)
   
9.         For C = 1 To UBound(AR, 2) Step 2       '陣列:第二維(欄)  Step 2 間隔 2欄
   
10.             Application.StatusBar = AR(R, C)
    
11.             Set termPing = GetObject("winmgmts:").ExecQuery _
    
12.                     ("Select * from Win32_PingStatus where Address = '" & AR(R, C) & "'")
    
13.             For Each termStatus In termPing
    
14.                 With termStatus
    
15.                     If IsNull(.StatusCode) Or .StatusCode <> 0 Then ' Terminal失敗
    
16.                         AR(R, C + 1) = "Termin 3G不通" '                termresResult = "Time Out"
    
17.                     Else ' 成功
    
18.                         AR(R, C + 1) = "Termin 3G通" '                termresResult = .ResponseTime & "ms"   '取得ATUR回應時間
    
19.                     End If
    
20.                 End With
    
21.             Next
    
22.         Next
    
23.     Next
    
24.     Rng = AR                        '導出陣列
    
25.     Application.StatusBar = "OK"
    
26. End Sub

複製代碼

c_c_lai

回復 9# GBKEE

1. Set Rng = .Range("C2", .Range("C2").End(xlDown)).Resize(, .Range("C1").End(xlToRight).Column - 2)

複製代碼

需改成：

1. Set Rng = .Range("C2", .Range("C65535").End(xlUp)).Resize(, .Range("C1").End(xlToRight).Column - 2)

複製代碼

否則會發生溢位。