返回列表 上一主題 發帖

求使用vba ping

回復 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

回復 6# loveinput
Sub ipchange() 不能正常執行, 奢談我主要是執行ping1~ping7的動作,希望能同時執行!!
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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

回復 10# c_c_lai
9#程式的前提是已執行8#附檔的 ipchange()
如會溢位應資料量大時是  C As Integer
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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

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

  8.     With cnn
  9.         If .State = 1 Then .Close    '  adStateOpen
  10.         .Provider = "Microsoft.Jet.OLEDB.4.0"
  11.        ' .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
  12.                             ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
  13.         .Open ActiveWorkbook.Path & "\機票記錄明細表.mdb"
  14.     End With
  15. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 道德是提昇自我的明燈,不該是呵斥別人的鞭子。
返回列表 上一主題