回答編集履歴

1

正規表現による、条件にESTABLISHEDを追加

2020/10/17 03:26

投稿

nono789
nono789

スコア1

test CHANGED
@@ -10,89 +10,95 @@
10
10
 
11
11
  ```VBA
12
12
 
13
- Sub test()
13
+ Sub test3()
14
14
 
15
15
 
16
16
 
17
- Dim WSH, wExec, cmd As String, Result As String
17
+ Dim WSH, wExec, cmd As String, Result As String
18
-
19
- Set WSH = CreateObject("WScript.Shell")
20
-
21
-
22
-
23
- ' 実行したいDOSコマンド
24
-
25
- cmd = "netstat -n"
26
-
27
-
28
-
29
- ' DOSコマンドを実行
30
-
31
- Set exec = WSH.exec("%ComSpec% /c " & cmd)
32
-
33
-
34
-
35
- ' DOSコマンドが終了するまで待機
36
-
37
- Do While exec.Status = 0
38
-
39
- DoEvents
40
-
41
- Loop
42
-
43
-
44
-
45
- ' DOSコマンドの実行結果(標準出力)を取得
46
-
47
- Result = exec.StdOut.ReadAll
48
-
49
-
50
-
51
- ' 取得した標準出力をメッセージボックスに表示
52
-
53
- MsgBox Result
54
-
55
-
56
18
 
57
19
 
58
20
 
59
- ' 実行結果を行毎に区切る
21
+
60
22
 
61
- tmp = Split(Result, vbCrLf)
23
+ Set WSH = CreateObject("WScript.Shell")
62
24
 
63
-
25
+
64
26
 
65
- For n = 0 To UBound(tmp)
27
+ ' 実行したいDOSコマンド
66
28
 
67
- buf = tmp(n) & vbCrLf
29
+ cmd = "netstat -n"
68
30
 
69
-
31
+
70
32
 
71
- '3389で前後にわける
33
+ ' DOSコマンドを実行
72
34
 
73
- If InStr(buf, "3389") Then
35
+ Set wExec = WSH.exec("%ComSpec% /c " & cmd)
36
+
37
+
38
+
39
+ ' DOSコマンドが終了するまで待機
40
+
41
+ Do While wExec.Status = 0
42
+
43
+ DoEvents
44
+
45
+ Loop
46
+
47
+
48
+
49
+ ' DOSコマンドの実行結果(標準出力)を取得
50
+
51
+ Result = wExec.StdOut.ReadAll
52
+
53
+
54
+
55
+ ' 取得した標準出力をメッセージボックスに表示
56
+
57
+ MsgBox Result
74
58
 
75
59
 
76
60
 
77
- buf2 = Split(buf, "3389")
78
-
79
- buf3 = Split(buf2(1), ":")
80
-
81
- Cells(5, 2) = Trim(buf3(0))
82
61
 
83
62
 
84
63
 
85
- End If
86
64
 
87
- Next n
88
65
 
89
-
90
66
 
91
- ' オブジェクトを空に
67
+ Set RE = CreateObject("VBScript.RegExp")
92
68
 
93
- Set wExec = Nothing
94
69
 
70
+
71
+ ' 正規表現の条件を設定
72
+
73
+ RE.Pattern = "^\s*\S+\s+\S+:3389\s+(\S+):\d+\s+ESTABLISHED\s*$"
74
+
75
+ RE.MultiLine = True ' 複数行に対して検索する指定
76
+
77
+
78
+
79
+ ' 検索
80
+
81
+ Set reMatch = RE.Execute(Result)
82
+
83
+
84
+
85
+ ' 最初に条件に該当した行の、最初のカッコ内(=IPアドレス部分)を取り出し
86
+
87
+ Cells(7, 2) = reMatch(0).SubMatches.Item(0)
88
+
89
+
90
+
91
+
92
+
93
+ ' オブジェクトを空に
94
+
95
+ Set reMatch = Nothing
96
+
97
+ Set RE = Nothing
98
+
99
+ Set wExec = Nothing
100
+
95
- Set WSH = Nothing
101
+ Set WSH = Nothing
96
102
 
97
103
 
98
104