測試IP

帖子: 14
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: 宜蘭
註冊時間: 2013-8-26
最後登錄: 2013-12-19

2^#

發表於 2013-8-28 08:57 | 顯示全部帖子

本帖最後由 linderlong 於 2013-8-28 08:59 編輯

回復 2# c_c_lai

感謝大大的指導！已可以使用，但速度上略為緩慢，不知有無方法提升測試的速度，程式如下：
假設a1至a10儲存格內容各為100.18.22.1至100.18.22.10，在我的電腦上執行完一次，要費時45秒，時間上太久了，不知如何縮短時程？謝謝！

Public Sub iptest()
  Columns("B:B").Select
  Selection.ClearContents
  Range("A1").Select
  費時 = Timer
  i = 1
  Do While Cells(i, 1) <> ""
Cells(i, 2) = Ping(Cells(i, 1))
i = i + 1
  Loop
  Cells(1, 3) = Timer - 費時
End Sub

Private Function Ping(strAddr As String) As String
Dim strTmpFile As String
strTmpFile = Environ("TEMP") & "\PingResult.txt" '  準備建暫存檔在 Windows Temp 目錄下
CreateObject("WScript.Shell").Run Environ("COMSPEC") & " /c PING -n 1 " & strAddr & " > " & strTmpFile, 0, True
Ping = CreateObject("Scripting.FileSystemObject").OpenTextFile(strTmpFile).ReadAll
Ping = Replace(Ping, vbCrLf, "", 1)
On Error Resume Next
Kill strTm
End Function

龍

帖子: 14
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: 宜蘭
註冊時間: 2013-8-26
最後登錄: 2013-12-19

3^#

發表於 2013-8-28 10:52 | 顯示全部帖子

由於要測試的ip有近百個，如此一來則須要好長的時間。
假若事先在d:\iptest\的目錄下先建好要測試ip的10個批次檔（內容為Ping -n 1 100.18.22.1 > D:\iptest\1.txt），再以下列程式執行測試則僅須不到2秒的時間，但由程式過於冗長，才想請教看看是否有程式簡潔且費時短的方法，謝謝！

Public Sub 工作()
  '測試ip
  費時 = Timer
  列 = 1
  For i = 1 To 10
批次檔 = "d:\iptest\" & i & ".BAT"
a = Shell(批次檔, 0)
  Next i

  休息 = Timer
  Do While Timer - 休息 < 1
DoEvents
  Loop

  '讀取結果
  For i = 1 To 10
文字檔 = "d:\iptest\" & i & ".TXT"
代碼 = FreeFile ' 取得未使用的檔案代碼。
Open 文字檔 For Input As #代碼
cells(i, 2) = Input(120, #代碼)
Close #代碼 ' 關閉檔案。
  Next i
  cells(1, 3) = Timer - 費時
End Sub

龍

帖子: 14
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: 宜蘭
註冊時間: 2013-8-26
最後登錄: 2013-12-19

4^#

發表於 2013-8-28 15:00 | 顯示全部帖子

正研究中，十分感激！謝謝！

龍

帖子: 14
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: 宜蘭
註冊時間: 2013-8-26
最後登錄: 2013-12-19

5^#

發表於 2013-8-28 16:00 | 顯示全部帖子

回復 6# c_c_lai
假設a1至a10儲存格內容各為100.18.22.1至100.18.22.10，而將ping的結果依序放在B1至B10的儲存格上，程式如下，已經測試在xp及W7，32位元可以執行，但在W7，64位元系統則在 RetVal = Shell("command.com /c Ping -n 1 " & Cells(i, 1) & " > " & ThisWorkbook.Path & "\" & i & ".txt") 這行指令發生錯誤，請問如何修正？謝謝！

另外不知有無方法直接將 ping 的結果直接寫入B1至B10的儲存格，而不必經由寫入txt檔後，再開啟txt檔將其寫入B1至B10儲存格內。十分感激！

Sub Test()
  Columns("B:C").Select
  Selection.ClearContents
  費時 = Timer
  For i = 1 To 10
RetVal = Shell("command.com /c Ping -n 1 " & Cells(i, 1) & " > " & ThisWorkbook.Path & "\" & i & ".txt")
  Next i

  休息 = Timer
  Do While Timer - 休息 < 2
DoEvents
  Loop

  For i = 1 To 10
文字檔 = ThisWorkbook.Path & "\" & i & ".TXT"
代碼 = FreeFile ' 取得未使用的檔案代碼。
Open 文字檔 For Input As #代碼
字長 = LOF(代碼)
Cells(i, 2) = Input(字長, #代碼)
Close #代碼 ' 關閉檔案。
  Next i
  Cells(1, 3) = Timer - 費時
End Sub

龍

帖子: 14
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: 宜蘭
註冊時間: 2013-8-26
最後登錄: 2013-12-19

6^#

發表於 2013-8-29 11:08 | 顯示全部帖子

回復 9# c_c_lai
已改為sheet1.cells(i,1)在w7,64位元,office2007下，仍舊無法執行，不知為何原因？謝謝！

龍

帖子: 14
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: 宜蘭
註冊時間: 2013-8-26
最後登錄: 2013-12-19

7^#

發表於 2013-8-29 13:41 | 顯示全部帖子

應該不是office的問題，而是作業系統w7，32位元，可以執行，而在64位元系統，則錯在
RetVal = Shell("command.com /c Ping -n 1 " & 工作表1.Cells(cts, 1) & " > " & ThisWorkbook.Path & "\iptest" & cts & ".txt")
這行指令上，不知為何原因？謝謝！

龍

帖子: 14
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
來自: 宜蘭
註冊時間: 2013-8-26
最後登錄: 2013-12-19

8^#

發表於 2013-8-30 14:41 | 顯示全部帖子

本帖最後由 linderlong 於 2013-8-30 14:43 編輯

在w7,64位元,office2007下，逐步執行時，則停在下列指令，
RetVal = Shell("command.com /c Ping -n 1 " & Cells(i, 1) & " > " & ThisWorkbook.Path & "\" & i & ".txt")

按一下說明，出現以下文字，但看不懂，不知如何修正？不知道是不是找到 command.com 這個dos指令？

找不到檔案 (錯誤 53)

所指定的檔案找不到。此錯誤有以下的起因和解決方法：
‧ 陳述式如 Kill、SetAttr 或 Name 等，引用到一個不存在的檔案。
檢查檔案名稱的拼字以及路徑說明。
‧ 欲呼叫動態連結程式庫 (DLL) 中的程序或 Macintosh程式碼資源區，但找不到在 Declare 陳述式的 Lib 子句中所指定程式庫檔案名稱或資源當案名稱。
檢查檔案名稱的拼字以及路徑說明。
‧ 在發展環境中，如果您欲開啟不存在的專案或載入不存在的文字檔案，將發生錯誤。
檢查檔案名稱或專案名稱的拼字以及路徑說明。
詳細資訊，可選取有疑問的項目並按下 F1 (在Windows中) 或 HELP (在Macintosh上)。

龍