VBAから手軽にDOSコマンドやPowerShellを実行して結果を取得するモジュールを作成

システムの運用をやっていると、VBAからDOSコマンドとかPowerShellを実行したくなるケースがある。
WScript.ShellのExecメソッドなら標準出力が取得できるのだが、一瞬DOS窓が開いてしまうのがちょっと格好悪い。

非表示でやりたいと思ったら、Runコマンドでコマンド結果をリダイレクトでファイルに書き込み、それを読み込むという面倒なことをしないといけない。

ああ面倒くさい。。

ということで、楽にそういうことができるようにモジュールで包んで抽象化した。
さて、普段なら作り方から説明するんだけれど、今回はコードが長いのでまず使う方のコードを紹介しよう。

使い方

たとえばipconfig /allの結果を取得したいとする。

記述するコードは、

なんと、これだけ！(いぇい!)

Sub Sample1()
    Debug.Print SystemAccessor.GetCommandResult("ipconfig /all")
End Sub

パイプも、ばっちりOK。

Sub Sample2()
    Debug.Print SystemAccessor.GetCommandResult("ipconfig /all | find ""IPv4""")
End Sub

ダブルクォーテーションのエスケープがちょっとめんどい。

Sub Sample3()
    Debug.Print SystemAccessor.GetCommandResult("dir ""c:\program files""")
End Sub

PowerShellコマンドはGetPSCommandResultと書く。

Sub Sample4()
    Debug.Print SystemAccessor.GetPSCommandResult("service")
End Sub

オブジェクトパイプもばっちり

Sub Sample5()
    Debug.Print SystemAccessor.GetPSCommandResult("service|?{$_.status -eq 'Running'}")
End Sub

※ただしPowerShellの場合はコマンド全体をダブルクォートで囲ってInvoke-Expressionに渡しているので、指定するコマンド内にダブルクォートが使えない。代わりにシングルクォートを使う。

その他、結果を1行ごとに分けて配列として返すメソッドとテキストストリームとして返すメソッドを用意している。
また、FileSystemObjectとWScript.ShellはそれぞれSharedFSO、SharedWshShellというプロパティで外部公開しているので、以下のように変数も作らずにいきなり使用することができる。(AriawaseのIOモジュールからアイデアをいただきました。)

f:id:t-hom:20170131011949p:plain

ただし、以下を参照設定しておかないと入力候補は出ない。

Microsoft Scripting Runtime
Windows Script Host Object Model

2017/2/2 追記

このモジュールからPowerShellコマンドを使う際に一つ問題が発覚。
ひとつめのコマンドにパラメーターをつける場合、パラメーターごとシングルクォートで括る必要があるようだ。

Sub Sample()
    Debug.Print SystemAccessor.GetPSCommandResult( _
        "'Get-Service -ComputerName x200'" & _
            "|Where-Object{$_.Status -eq 'Running'}" & _
            "|Select-Object -f 10")
End Sub

詳細はこちら
thom.hateblo.jp

作り方

まず、標準モジュールを作成し、モジュール名を「SystemAccessor」とする。
次に以下のコードをコピーして貼り付けるだけ。

参照設定しなくても動作するけど、参照設定する場合は#Const REF = Falseを#Const REF = Trueに書き換える。

#Const REF = False
'If REF then require references below _
- Microsoft Scripting Runtime _
- Windows Script Host Object Model

'If Not REF Then Requir Nothing

#If REF Then
Private fso_ As Scripting.FileSystemObject
Private shell_ As IWshRuntimeLibrary.WshShell
#Else
Private fso_ As Object
Private shell_ As Object
#End If

#If REF Then
Property Get SharedFSO() As Scripting.FileSystemObject
#Else
Property Get SharedFSO() As Object
#End If
    If fso_ Is Nothing Then Set fso_ = CreateObject("Scripting.FileSystemObject")
    Set SharedFSO = fso_
End Property

#If REF Then
Property Get SharedWshShell() As IWshRuntimeLibrary.WshShell
#Else
Property Get SharedWshShell() As Object
#End If
    If shell_ Is Nothing Then Set shell_ = CreateObject("WScript.Shell")
    Set SharedWshShell = shell_
End Property

Function GetTempFilePath(Optional create_file As Boolean = False) As String
    Dim ret As String
    ret = Environ$("temp") & "\" & SharedFSO.GetTempName
    If create_file Then
        Call SharedFSO.CreateTextFile(ret)
    End If
    GetTempFilePath = ret
End Function

#If REF Then
Function GetCommandResultAsTextStream(command_string, Optional temp_path) As Scripting.TextStream
#Else
Function GetCommandResultAsTextStream(command_string, Optional temp_path) As Object
#End If
    Dim tempPath As String
    If IsMissing(temp_path) Then
        tempPath = GetTempFilePath
    Else
        tempPath = temp_path
    End If
#If Not REF Then
    Const WshHide = 0
    Const ForReading = 1
#End If
    Call SharedWshShell.Run("cmd.exe /c " & command_string & " > " & tempPath, WshHide, True)
    Set GetCommandResultAsTextStream = SharedFSO.OpenTextFile(tempPath, ForReading)
End Function

Function GetCommandResult(command_string) As String
    Dim ret As String
#If REF Then
    Dim ts As Scripting.TextStream
#Else
    Dim ts As Object
#End If
    Dim tempPath As String: tempPath = GetTempFilePath
    Set ts = GetCommandResultAsTextStream(command_string, tempPath)
    If ts.AtEndOfStream Then
        ret = ""
    Else
        ret = ts.ReadAll
    End If
    ts.Close
    Call SharedFSO.DeleteFile(tempPath, True)
    GetCommandResult = ret
End Function

Function GetCommandResultAsArray(command_string) As String()
    Dim ret() As String
    ret = Split(GetCommandResult(command_string), vbNewLine)
    GetCommandResultAsArray = ret
End Function

#If REF Then
Function GetPSCommandResultAsTextStream(command_string, Optional temp_path) As Scripting.TextStream
#Else
Function GetPSCommandResultAsTextStream(command_string, Optional temp_path) As Object
#End If
    Dim tempPath As String
    If IsMissing(temp_path) Then
        tempPath = GetTempFilePath
    Else
        tempPath = temp_path
    End If
#If Not REF Then
    Const WshHide = 0
    Const ForReading = 1
#End If
    Call SharedWshShell.Run("powershell -ExecutionPolicy RemoteSigned -Command Invoke-Expression """ & command_string & " | Out-File -filePath " & tempPath & " -encoding Default""", WshHide, True)
    Set GetPSCommandResultAsTextStream = SharedFSO.OpenTextFile(tempPath, ForReading)
End Function

Function GetPSCommandResult(command_string) As String
    Dim ret As String
#If REF Then
    Dim ts As Scripting.TextStream
#Else
    Dim ts As Object
#End If
    Dim tempPath As String: tempPath = GetTempFilePath
    Set ts = GetPSCommandResultAsTextStream(command_string, tempPath)
    If ts.AtEndOfStream Then
        ret = ""
    Else
        ret = ts.ReadAll
    End If
    ts.Close
    Call SharedFSO.DeleteFile(tempPath, True)
    GetPSCommandResult = ret
End Function

Function GetPSCommandResultAsArray(command_string) As String()
    Dim ret() As String
    ret = Split(GetPSCommandResult(command_string), vbNewLine)
    GetPSCommandResultAsArray = ret
End Function