t-hom’s diary

主にVBAネタを扱っているブログです。

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

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

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

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。