帖子: 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是否正確，請問該怎麼去寫?!

loveinput

小學生 Rank: 1

帖子: 6
主題: 1
精華: 0
積分: 7
點名: 0
作業系統: windows
軟體版本: office 2010
閱讀權限: 10
性別: 男
註冊時間: 2013-12-23
最後登錄: 2016-9-29

15^#

發表於 2014-1-9 18:03 | 只看該作者

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

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

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

14^#

發表於 2014-1-8 14:55 | 只看該作者

回復 13# GBKEE
謝謝您！

.Open ActiveWorkbook.Path & "\機票記錄明細表.mdb"

複製代碼

事實上我並不是要開啟 "機票記錄明細表.mdb"，而是要指向已開啟的 Excel 本身，
因為接下來要查詢、刪除、新增、或更新的標的均為 Excel 本身指定的工作表單
資料錄而非 Access 資料庫的資料錄。
謝謝您！

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

13^#

發表於 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

Sub Test()
Dim cnn As Object ' New ADODB.Connection
Dim cmd As Object ' New ADODB.Command
Dim rs As Object ' New ADODB.Recordset
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set cmd = CreateObject("ADODB.Command")
With cnn
If .State = 1 Then .Close ' adStateOpen
.Provider = "Microsoft.Jet.OLEDB.4.0"
' .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
.Open ActiveWorkbook.Path & "\機票記錄明細表.mdb"
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

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

12^#

發表於 2014-1-8 10:01 | 只看該作者

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

Sub Test()
Dim cnn As Object ' New ADODB.Connection
Dim cmd As Object ' New ADODB.Command
Dim rs As Object ' New ADODB.Recordset
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set cmd = CreateObject("ADODB.Command")
With cnn
If .State = 1 Then .Close ' adStateOpen
.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
.Open
End With
End Sub

複製代碼

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

11^#

發表於 2014-1-8 08:38 | 只看該作者

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

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

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

10^#

發表於 2014-1-8 08:27 | 只看該作者

回復 9# GBKEE

Set Rng = .Range("C2", .Range("C2").End(xlDown)).Resize(, .Range("C1").End(xlToRight).Column - 2)

複製代碼

需改成：

Set Rng = .Range("C2", .Range("C65535").End(xlUp)).Resize(, .Range("C1").End(xlToRight).Column - 2)

複製代碼

否則會發生溢位。

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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
同時跑兩個程式! (程式執行時,移動滑鼠,鍵盤,易出錯)

Option Explicit
Sub Ex_Ping()
Dim AR(), Rng As Range, R As Integer, C As Integer, termPing As Object, termStatus As Variant
With Worksheets("Sheet1")
Set Rng = .Range("C2", .Range("C2").End(xlDown)).Resize(, .Range("C1").End(xlToRight).Column - 2)
AR = Rng '轉入陣列
End With
For R = 1 To UBound(AR) '陣列:第一維(列)
For C = 1 To UBound(AR, 2) Step 2 '陣列:第二維(欄) Step 2 間隔 2欄
Application.StatusBar = AR(R, C)
Set termPing = GetObject("winmgmts:").ExecQuery _
("Select * from Win32_PingStatus where Address = '" & AR(R, C) & "'")
For Each termStatus In termPing
With termStatus
If IsNull(.StatusCode) Or .StatusCode <> 0 Then ' Terminal失敗
AR(R, C + 1) = "Termin 3G不通" ' termresResult = "Time Out"
Else ' 成功
AR(R, C + 1) = "Termin 3G通" ' termresResult = .ResponseTime & "ms" '取得ATUR回應時間
End If
End With
Next
Next
Next
Rng = AR '導出陣列
Application.StatusBar = "OK"
End Sub