Board logo

標題: 求使用vba ping [打印本頁]
作者: loveinput    時間: 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    時間: 2013-12-24 08:52

回復 1# loveinput
麻辣網站上有豐富的資訊可供查詢與進修。
你的提問可以去參考：
測試IP
作者: loveinput    時間: 2014-1-4 17:32

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

再請指教
[attach]17198[/attach]
作者: loveinput    時間: 2014-1-6 15:48

更新附件為excel
[attach]17201[/attach]
作者: GBKEE    時間: 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
複製代碼
作者: loveinput    時間: 2014-1-7 18:49

謝謝GBKEE的回覆，可能我沒說清楚，我主要是執行ping1~ping7的動作，希望能同時執行!!
再肯請指教!!
作者: GBKEE    時間: 2014-1-7 19:58

回復 6# loveinput
Sub ipchange() 不能正常執行, 奢談我主要是執行ping1~ping7的動作，希望能同時執行!!
作者: loveinput    時間: 2014-1-7 20:30

[attach]17216[/attach]
果真是奢談阿!!還望指導，更新如附件
作者: GBKEE    時間: 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
複製代碼
作者: c_c_lai    時間: 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)
複製代碼
否則會發生溢位。
作者: GBKEE    時間: 2014-1-8 08:38

回復 10# c_c_lai
9#程式的前提是已執行8#附檔的 ipchange()
如會溢位應資料量大時是  C As Integer
作者: c_c_lai    時間: 2014-1-8 10:01

回復 11# GBKEE
順帶請教您：
以下測試於2003 Excel中， 於 Set cnn 後發現 cnn 值為 ""，
所以在 .Open 時便出錯了。在工具->設定引用項目中要注意那些項次？
但是此語法在 2010 環境下執行都 OK，正確應如何處裡？
P.S. 這是我在 Excel工作表單與Access資料庫的VBA互動問題 中的提問，
     此部分是為了要同時以 ADODB 語法來處理工作表單內之資料錄而設定的。
  1. Sub Test()
  2.     Dim cnn As Object       '  New ADODB.Connection
  3.     Dim cmd As Object       '  New ADODB.Command
  4.     Dim rs As Object        '  New ADODB.Recordset

  6.     Set cnn = CreateObject("ADODB.Connection")
  7.     Set rs = CreateObject("ADODB.Recordset")
  8.     Set cmd = CreateObject("ADODB.Command")

  10.     With cnn
  11.         If .State = 1 Then .Close    '  adStateOpen
  12.         
  13.         .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
  14.                             ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
  15.         .Open     
  16.     End With
  17. End Sub
複製代碼
作者: GBKEE    時間: 2014-1-8 11:35

回復 12# c_c_lai
http://neural.cs.nthu.edu.tw/jan ... asp?SessionCount=11
http://support.microsoft.com/kb/257819/zh-tw#RetrieveMetadata
http://www.blueshop.com.tw/board ... 10110153028R5I.html
  1. Sub Test()
  2.     Dim cnn As Object       '  New ADODB.Connection
  3.     Dim cmd As Object       '  New ADODB.Command
  4.     Dim rs As Object        '  New ADODB.Recordset

  6.     Set cnn = CreateObject("ADODB.Connection")
  7.     Set rs = CreateObject("ADODB.Recordset")
  8.     Set cmd = CreateObject("ADODB.Command")

  10.     With cnn
  11.         If .State = 1 Then .Close    '  adStateOpen
  12.         .Provider = "Microsoft.Jet.OLEDB.4.0"
  13.        ' .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
  14.                             ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
  15.         .Open ActiveWorkbook.Path & "\機票記錄明細表.mdb"
  16.     End With
  17. End Sub
複製代碼
作者: c_c_lai    時間: 2014-1-8 14:55

回復 13# GBKEE
謝謝您！
  1. .Open ActiveWorkbook.Path & "\機票記錄明細表.mdb"
複製代碼
事實上我並不是要開啟 "機票記錄明細表.mdb"，而是要指向已開啟的 Excel 本身，
因為接下來要查詢、刪除、新增、或更新的標的均為  Excel 本身指定的工作表單
資料錄而非 Access 資料庫的資料錄。
謝謝您！
作者: loveinput    時間: 2014-1-9 18:03

感謝大家的回覆與幫忙!!



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)