測試IP - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 測試IP

返回列表下一主題上一主題發帖

測試IP

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

1^# 跳轉到 »

發表於 2013-8-26 16:35 | 顯示全部帖子

回復 1# linderlong
試試看用下列 Function 看看：

Public Sub iptest()
MsgBox Ping("10.18.22.5")
End Sub

複製代碼

Private Function Ping(strAddr As String) As String
Dim strTmpFile As String
strTmpFile = Environ("TEMP") & "\PingResult.txt" ' 準備建暫存檔在 Windows Temp 目錄下
' 建立 WScript 物件 Shell 類別 , 使用 Run 方法 , 呼叫外部指令 Ping ( 並等待其執行結束 )
CreateObject("WScript.Shell").Run Environ("COMSPEC") & " /c PING " & strAddr & " > " & strTmpFile, 0, True
' PS : "Ping IP位置 > XX檔案" 這裡是使用 > 來將 Ping 結果寫到檔案裡
' ( 當然也可 Call API CreatePipe 來讀取命令結果 )
' Ping 是一種公用程式，可以驗證一或多個遠端主機連線。
' Ping 指令用 ICMP 回應要求和回應回覆套裝軟體來決定網路上的特殊 IP 系統是否正常運作。
' Ping 對診斷 IP 網路或路由器失敗非常有用。
' Internet Control Message Protocol (ICMP)
' TCP/IP 組件中必要的一種維護通訊協定，可報告錯誤並允許簡易連線。
' Ping 工具用來執行 TCP/IP 疑難排解的 ICMP。
' 詳細說明及用法可參考:
' ms-its:%WINDIR%\Help\ntcmds.chm::/ping.htm
' ms-its:%WINDIR%\Help\ntcmds.chm::/ping.htm
' ms-its:%WINDIR%\Help\tcpip.chm::/sag_TCPIP_pro_PingConnect.htm
' ms-its:%WINDIR%\Help\tcpip.chm::/sag_TCPIP_pro_Ping.htm
' 建立檔案系統物件,用來開啟暫存文字檔,並讀取內容 ( 取回 Ping的結果 )
Ping = CreateObject("Scripting.FileSystemObject").OpenTextFile(strTmpFile).ReadAll
Ping = Replace(Ping, vbCrLf, "", 1)
On Error Resume Next
Kill strTmpFile ' 刪除暫存檔
End Function

複製代碼

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

2^#

發表於 2013-8-28 09:37 | 顯示全部帖子

回復 3# linderlong
我連上 Google 約需五秒，如下圖所示：

如以 .1 到 .10 要 45 秒 (偵測外部 IP)，
應是合理範圍。

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

3^#

發表於 2013-8-28 14:31 | 顯示全部帖子

本帖最後由 c_c_lai 於 2013-8-28 14:33 編輯

回復 5# linderlong
你試著用 Shell command 的方式執行看看：

Sub Test()
Dim strIP As String, sp As Variant, RetVal
Dim cts As Integer, xi As Integer
strIP = "100.18.22.1,100.18.22.2,100.18.22.3,100.18.22.4,100.18.22.5,100.18.22.6,100.18.22.7,100.18.22.8,100.18.22.9,100.18.22.10"
sp = Split(strIP, ",")
cts = 0
For xi = 0 To UBound(sp)
cts = cts + 1
' RetVal = Shell("command.com /c Ping -n 1 100.18.22.1 > D:\iptest\1.txt")
RetVal = Shell("command.com /c Ping -n 1 " & sp(xi) & " > " & ThisWorkbook.Path & "\iptest" & cts & ".txt")
工作表1.Cells(cts, 1) = sp(xi)
Next xi
End Sub

複製代碼

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

4^#

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

回復 8# linderlong
請將 Cells(i, 1) 明確指定工作表單之歸屬。
譬如： Sheet1.Cells(i, 1) 等。

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

5^#

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

回復 10# linderlong

RetVal = Shell("command.com /c Ping -n 1 " & 工作表1.Cells(cts, 1) & " > " & ThisWorkbook.Path & "\iptest" & cts & ".txt")

複製代碼

經實地在 Excel 2010 下測試是無誤的，
請檢查你的執行錯誤點是在哪一段？

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

6^#

發表於 2013-8-29 12:02 | 顯示全部帖子

回復 10# linderlong

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

7^#

發表於 2013-8-30 15:44 | 顯示全部帖子

回復 14# linderlong
試著在 WinX 64 位元環境下測試是否OK？

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

8^#

發表於 2013-8-30 15:47 | 顯示全部帖子

回復 14# linderlong
你直接將 Debug 畫面完整 Copy 上傳 (需有錯誤點指向)

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

9^#

發表於 2013-8-30 16:33 | 顯示全部帖子

回復 18# linderlong
RetVal 上行插入 DoEvents 試試看。

DoEvents
RetVal = Shell("command.com /c Ping -n 1 " & Cells(i, 1) & " > " & ThisWorkbook.Path & "\" & i & ".txt")

複製代碼

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

10^#

發表於 2013-8-30 17:09 | 顯示全部帖子

回復 20# linderlong
這是你網路權限不夠的緣故。
亦即 Users' 的權限不足無法指到 Windows/system32/ 的路徑。

靜思自在 : 有心就有福，有願就有力，自造福田，自得福緣。

返回列表下一主題上一主題