12
返回列表 上一主題 發帖

求使用vba ping

loveinput

帖子
6 
主題
1 
精華
0 
積分
7 
點名
0  
作業系統
windows 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2013-12-23 
最後登錄
2016-9-29 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-12-23 13:53 | 只看該作者

求使用vba ping

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

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
2#
發表於 2013-12-24 08:52 | 只看該作者
回復 1# loveinput
麻辣網站上有豐富的資訊可供查詢與進修。
你的提問可以去參考：
測試IP

TOP

loveinput

帖子
6 
主題
1 
精華
0 
積分
7 
點名
0  
作業系統
windows 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2013-12-23 
最後登錄
2016-9-29 
3#
發表於 2014-1-4 17:32 | 只看該作者
各位先進
想請問我有一個ping的程式了，目前只能一個for迴圈結束後
才能繼續執行另一個迴圈，但是希望能同時執行兩個迴圈!!
已翻過討論區與google了，還是不了解該怎麼解或該將doevents加在那

再請指教
pinguse.zip (789 Bytes)

TOP

loveinput

帖子
6 
主題
1 
精華
0 
積分
7 
點名
0  
作業系統
windows 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2013-12-23 
最後登錄
2016-9-29 
4#
發表於 2014-1-6 15:48 | 只看該作者
更新附件為excel
upping.zip (83.77 KB)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2014-1-7 08:35 | 只看該作者
回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

loveinput

帖子
6 
主題
1 
精華
0 
積分
7 
點名
0  
作業系統
windows 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2013-12-23 
最後登錄
2016-9-29 
6#
發表於 2014-1-7 18:49 | 只看該作者
謝謝GBKEE的回覆，可能我沒說清楚，我主要是執行ping1~ping7的動作，希望能同時執行!!
再肯請指教!!

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2014-1-7 19:58 | 只看該作者
回復 6# loveinput
Sub ipchange() 不能正常執行, 奢談我主要是執行ping1~ping7的動作，希望能同時執行!!
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

loveinput

帖子
6 
主題
1 
精華
0 
積分
7 
點名
0  
作業系統
windows 
軟體版本
office 2010 
閱讀權限
10 
性別
男 
註冊時間
2013-12-23 
最後登錄
2016-9-29 
8#
發表於 2014-1-7 20:30 | 只看該作者
upping.zip (83.88 KB)
果真是奢談阿!!還望指導，更新如附件

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2014-1-8 07:31 | 只看該作者
回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
10#
發表於 2014-1-8 08:27 | 只看該作者
回復 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)
複製代碼
否則會發生溢位。

TOP

        靜思自在 : 話多不如話少，話少不如話好。
12
返回列表 上一主題