PowerShellのスクリプトを、実行権限がRestrictedのまま実行するためのVBA（ユーザ定義関数）

Yu-Tangさんの「DOS コマンドの実行結果を取得する方法」を参考に、VBAからPowerShellを実行する関数を作成してみました。

関数定義

VBA(標準モジュール)

Option Explicit

Const TEMPORARYFOLDER = 2
Private objShell As Object
Private objFso As Object
Private objFdr As Object

' 関数名：InitializeObjects
' 目　的：オブジェクトの初期化（初回のみ）
Public Sub InitializeObjects()
    If objShell Is Nothing Then Set objShell = CreateObject("WScript.Shell")
    If objFso Is Nothing Then Set objFso = CreateObject("Scripting.FileSystemObject")
    If objFdr Is Nothing Then Set objFdr = objFso.GetSpecialFolder(TEMPORARYFOLDER)
End Sub

' 関数名：ReleaseObjects
' 目　的：オブジェクトの解放（ブック終了前等に実行して下さい）
Public Sub ReleaseObjects()
    Set objShell = Nothing
    Set objFso = Nothing
    Set objFdr = Nothing
End Sub

' 関数名：BuildTempPath
' 目　的：一時ファイルパスの生成
Private Function BuildTempPath() As String
    Do
        BuildTempPath = objFso.BuildPath(objFdr.path, objFso.GetTempName)
    Loop While objFso.FileExists(BuildTempPath)
End Function

' 関数名：ReadAll
' 目　的：ファイルの内容をすべて読み込み
Private Function ReadAll(ByVal valPath As String) As String
    Dim objTs As Object
    If objFso.FileExists(valPath) Then
        Set objTs = objFso.OpenTextFile(valPath)
        If Not objTs.AtEndOfStream Then
            ReadAll = objTs.ReadAll
        End If
        objTs.Close
    End If
    Set objTs = Nothing
End Function


' 関数名：ExecPosh
' 目　的：PowerShell コマンドの実行結果の取得（コマンド指定タイプ）
' 戻り値：PowerShell コマンドの実行結果
' 引　数：valCommand        -> 必須/入力用です。実行コマンドを文字列型で指定します。
' 　　　　valTraceConsole   -> 任意/入力用です。実行コマンド及び実行結果をイミディエイトウィンドウに出力します。
' 　　　　valSuspendIfError -> 任意/入力用です。エラー発生時に一時停止します。
' 注　意：valSuspendIfErrorをTrueにすると、標準エラー出力、標準出力の順に結果が出力されます。
' 参　考：http://www.f3.dion.ne.jp/~element/msaccess/AcTipsGetDosResult.html
Public Function ExecPosh(ByVal valCommand As String, _
                         Optional ByVal valTraceConsole As Boolean = False, _
                         Optional ByVal valSuspendIfError As Boolean = False) _
                         As String
    'オブジェクトの初期化（初回のみ）
    InitializeObjects

    Dim valStdOutPath, valStdOutText As String
    Dim valStdErrPath, valStdErrText As String
    Dim valCurrent As String
    Dim valRunCommand As String
    valCurrent = ThisWorkbook.path

    If valTraceConsole Then Debug.Print "PS " & valCurrent & " > " & valCommand

    ' 一時ファイルパスを生成
    valStdOutPath = BuildTempPath()
    If valSuspendIfError Then
      valStdErrPath = BuildTempPath()
    End If

    ' コマンド実行
    valRunCommand = _
      "%ComSpec% /c" & _
      " cd " & valCurrent & _
      " & powershell -command """ & valCommand & """" & _
      " 1> " & valStdOutPath & _
      IIf(valSuspendIfError, " 2> " & valStdErrPath, " 2>&1")

    objShell.Run valRunCommand, 0, True

    ' 実行結果の取得
    valStdOutText = ReadAll(valStdOutPath)
    If valSuspendIfError Then
      valStdErrText = ReadAll(valStdErrPath)
    End If

    If valTraceConsole Then Debug.Print valStdOutText

    If valSuspendIfError Then
        If valTraceConsole Then Debug.Print valStdErrText
        Debug.Assert valStdErrText = ""
    End If

    ' 一時ファイルの削除
    Kill valStdOutPath
    If valSuspendIfError Then
      Kill valStdErrPath
    End If

    ExecPosh = IIf(valSuspendIfError, valStdErrText, "") & valStdOutText
End Function

' 関数名：CallPosh
' 目　的：PowerShell コマンドの実行結果の取得（スクリプトパス指定タイプ）
' 戻り値：PowerShell コマンドの実行結果
' 引　数：valPath           -> 必須/入力用です。PowerShellスクリプトのパスを文字列型で指定します。
'         valArgs           -> 必須/入力用です。PowerShellスクリプトの引数へ渡す値を文字列型で指定します。
'                              複数指定する場合は、スペース区切りで指定して下さい。（例 "arg1 arg2"）
' 引　数：valCommand        -> 必須/入力用です。実行コマンドを文字列型で指定します。
' 　　　　valTraceConsole   -> 任意/入力用です。実行コマンド及び実行結果をイミディエイトウィンドウに出力します。
' 　　　　valSuspendIfError -> 任意/入力用です。エラー発生時に一時停止します。
' 注　意：valSuspendIfErrorをTrueにすると、標準エラー出力、標準出力の順に結果が出力されます。
Public Function CallPosh(ByVal valPath As String, _
                         ByVal valArgs As String, _
                         Optional ByVal valTraceConsole As Boolean = False, _
                         Optional ByVal valSuspendIfError As Boolean = False) _
                         As String

    Dim valCommand As String
    valCommand = "$script = Get-Content '" & valPath & "';Invoke-Expression('&{' + $script + '} " & valArgs & "')"

    CallPosh = ExecPosh(valCommand, valTraceConsole, valSuspendIfError)
End Function

使い方（例）

EXCELのセルか、VBAのイミディエイトウィンドウで以下を実行する

ExecPosh（コマンド指定タイプ）

ExecPosh("$PSVersionTable.PSVersion | Select Major,Minor | ConvertTo-Csv -NTI")

結果

"Major","Minor"
"5","0"

CallPosh（スクリプトパス指定タイプ）

CallPosh("sample.ps1","minr 日本")

sample.ps1

param($name,$region);
echo ('私の名前は' + $name + 'です');
echo ($region + 'に住んでいます');

結果

私の名前はminrです
日本に住んでいます

まとめ

久々にVBAをやってみましたが、やっぱり実装が面倒臭かったです。