質問するログイン新規登録

質問編集履歴

3

スクリプトファイルの指定時に相対パスが使えるようにSet-Locationを追加、複数のスクリプトファイルを読み込んだり出来る様にStdinの利用を追加、出力時の余分な文字列を削除する関数の追加

2018/08/10 11:03

投稿

kmyzr
kmyzr

スコア305

title CHANGED
File without changes
body CHANGED
@@ -28,14 +28,60 @@
28
28
 
29
29
  作成したコード
30
30
  ```vba
31
- Function MyPowershell(ByVal ScriptName As String, ByVal FunctionName As String, Argument As String) As WshExec
31
+ Function MyPowershell(Optional ByVal ScriptName As String, Optional ByVal FunctionName As String, Optional Argument As String, Optional Exec As WshExec, Optional ByVal StdinClose As Boolean = True) As WshExec
32
32
  'Powershellスクリプトを実行してWshExecオブジェクトとして返す
33
33
 
34
34
  Dim Wsh As New WshShell
35
- Dim Exec As WshExec
36
- Set Exec = Wsh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -windowstyle hidden -command " & ". '" & ScriptName & "';" & FunctionName & " " & Argument)
37
- Set MyPowershell = Exec
35
+ If StdinClose And FunctionName <> "" And Exec Is Nothing Then
36
+ '処理一括実行
37
+ Dim Cmd As String
38
+ If ScriptName <> "" Then
39
+ Cmd = ". '" & ScriptName & "';"
40
+ End If
41
+ Set Exec = Wsh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -windowstyle hidden -command " & "Set-Location -Path('" & ThisWorkbook.Path & "');" & Cmd & FunctionName & " " & Argument)
42
+ Else
43
+ '処理随時実行
44
+ If Exec Is Nothing Then
45
+ Set Exec = Wsh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -windowstyle hidden")
46
+ End If
47
+ Call Exec.StdIn.WriteLine("Set-Location -Path('" & ThisWorkbook.Path & "')")
48
+ If ScriptName <> "" Then
49
+ Call Exec.StdIn.WriteLine(". '" & ScriptName & "'")
50
+ End If
51
+ If FunctionName <> "" Then
52
+ Call Exec.StdIn.WriteLine(FunctionName & " " & Argument)
53
+ Else
54
+ StdinClose = False
55
+ End If
56
+ If StdinClose Then
57
+ Exec.StdIn.Close
58
+ End If
59
+ End If
60
+ Set MyPowershell = Exec
38
61
  End Function
62
+
63
+ Function MyPowershellStdOut(ByVal Exec As WshExec) As String
64
+ 'Powershellの返値を余分な文字を削除して返す
65
+
66
+ '標準出力を受け取る
67
+ Dim Str As String
68
+ Str = Exec.StdOut.ReadAll
69
+
70
+ '除外対象の文字列の削除
71
+ Dim BefStr As String
72
+ Dim RegExp_ As New RegExp
73
+ RegExp_.Pattern = "PS .:\.+?\n"
74
+ Do
75
+ BefStr = Str
76
+ Str = RegExp_.Replace(BefStr, "")
77
+ Loop While (BefStr <> Str)
78
+ RegExp_.Pattern = "PS .:\.+?> $"
79
+ Str = RegExp_.Replace(BefStr, "")
80
+ BefStr = Str
81
+ RegExp_.Pattern = "\n$"
82
+ Str = RegExp_.Replace(BefStr, "")
83
+ MyPowershellStdOut = Str
84
+ End Function
39
85
  ```
40
86
 
41
87
  実行されるpowershellスクリプト
@@ -49,24 +95,39 @@
49
95
  ```vba
50
96
  Sub test()
51
97
  'LoopCountに設定されている数分同時実行を行う
98
+ 'Boundary の指定以上は随時実行に変更
52
99
 
53
- Const LoopCount As Long = 5
100
+ Const LoopCount As Long = 10
101
+ Const Boundary As Long = 5
54
102
 
55
103
  Dim Exec() As WshExec
56
104
  Dim i As Long
57
105
  ReDim Exec(LoopCount)
58
106
  For i = 0 To LoopCount
107
+ If i <= Boundary Then
59
- Set Exec(i) = MyPowershell(ThisWorkbook.Path & "\t est.ps1", "test", """入力テスト" & i & "`r`n二行目の入力テスト""")
108
+ Set Exec(i) = MyPowershell(".\t est.ps1", "test", """入力テスト" & i & "`r`n二行目の入力テスト""")
109
+ Else
110
+ Set Exec(i) = MyPowershell(".\t est.ps1")
111
+ End If
60
112
  Next i
61
113
 
114
+ '追加の実行
115
+ Dim j As Long
116
+ For j = 0 To LoopCount
117
+ If j > Boundary Then
118
+ Set Exec(j) = MyPowershell(, "test", """入力テスト" & j & "`r`n二行目の入力テスト""", Exec(j))
119
+ End If
120
+
121
+ Next j
122
+
62
123
  '結果の取得
63
- Dim j As Long
64
124
  Dim Str() As String
125
+ Dim k As Long
65
126
  ReDim Str(LoopCount)
66
- For j = 0 To LoopCount
127
+ For k = 0 To LoopCount
67
- Str(j) = Exec(j).StdOut.ReadAll
128
+ Str(k) = MyPowershellStdOut(Exec(k))
68
- Next j
129
+ Next k
69
-
130
+
70
131
  '結果の表示
71
132
  MsgBox Join(Str, vbCrLf)
72
133
  End Sub

2

タイトルの修正

2018/08/10 11:03

投稿

kmyzr
kmyzr

スコア305

title CHANGED
@@ -1,1 +1,1 @@
1
- VBAから完全非表示、非同期でPowershellスクリプト引数付で実行して、尚且つ 返値を受け取りたい
1
+ VBAからPowershellスクリプトを完全非表示、非同期引数付で実行して、尚且つ 返値を受け取りたい
body CHANGED
File without changes

1

Sub test()にてMyPowershell実行時最終の引数の指定が間違っていたため修正

2018/08/10 07:34

投稿

kmyzr
kmyzr

スコア305

title CHANGED
File without changes
body CHANGED
@@ -56,7 +56,7 @@
56
56
  Dim i As Long
57
57
  ReDim Exec(LoopCount)
58
58
  For i = 0 To LoopCount
59
- Set Exec(i) = MyPowershell(ThisWorkbook.Path & "\t est.ps1", "test", """入力テスト" & i & " `r`n二行目の入力テスト""")
59
+ Set Exec(i) = MyPowershell(ThisWorkbook.Path & "\t est.ps1", "test", """入力テスト" & i & "`r`n二行目の入力テスト""")
60
60
  Next i
61
61
 
62
62
  '結果の取得