12
11

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

64bit版VBAでScriptControlを使用する

Last updated at Posted at 2017-04-05

「64bit VBAでJScriptを使用したい」という場合であればこの記事よりシンプルかつ堅牢な方法があります。

VBAからJScriptのfunctionオブジェクトを使用する(64bit対応) - Qiita

はじめに

VBAでJScriptの機能を使用したりするのに使われるMicrosoft Script Control 1.0だが、64bit版の環境では通常生成することが出来ない。

しかし、強引な方法を取ることによって64bit版VBAでもScriptControlを使用することが出来る。

この記事では使用するための基本的な考え方と、簡単なサンプルを紹介する。

考え方

32bitの環境でScriptControlを生成し、64bitの環境へ持ってくる

見出しの通り32bitの実行環境ならオブジェクトを生成可能なので、その生成したオブジェクトをVBAに持ってくれば良い。

32bit-64bit間でオブジェクトの受け渡しをしても問題無いのかは、COMに関する知識が無いためなんとも言えないが、問題無くメンバーが参照でき、VBAのTypfOf演算子でも同一の型と判定されるためそこまで影響は無いと思われる。

サンプル

使用した手段

オブジェクトの生成(32bit環境)

32bit版PowerShellを実行してNew-Objectコマンドレットで生成する。

VBAへの受け渡し

MS OfficeのApplication.Runメソッドの引数に生成したオブジェクトを指定して受け渡す。

検証環境

Windows10 64bit
MSOffice Excel 2016 64bit
Windows PowerShell v5 32bit

コード

内部でPowerShellを使って自分をコールバックし、静的変数を介してオブジェクトを取得している。

  1. VBAからプロシージャが呼ばれる。
  2. 1.の中でPowerShellが自身を呼び出す(オブジェクトの生成・受け渡し)
  3. 1.は2.の処理でオブジェクトが受け渡されるまで待機する。
  4. 受け渡しが終わったらそのオブジェクトを返す。
'MSScriptControl.ScriptControlを取得する関数。
'Excel専用。

'引数
'ioScrCtrl:省略可
    '原則ユーザーは使用しない。
    'PowerShellから ScriptControl を受け取るためのもの
'返り値
    'MSScriptControl.ScriptControl
    '原則同じインスタンスを返す。

'Private にしてもOK(Application.Runはスコープ無視で実行出来るため)
Function GetScriptCtrl(Optional ByVal ioScrCtrl As Object) As Object 'As MSScriptControl.ScriptControl
'32bit版PowerShellへのパス ※環境依存
Dim ps32Path$:  ps32Path = VBA.Environ$("windir") & "\SysWOW64\WindowsPowerShell\v1.0\powershell.exe"

'このプロシージャの名前とモジュール名 ※環境依存
Const MODULE_PROC$ = "Module1.GetScriptCtrl"

'ProgID
Const PROG_ID$ = "MSScriptControl.ScriptControl"

'取得したいオブジェクトの型名(TypeNameでの判定用)
Const TYPE_NAME$ = "ScriptControl"

    'PowerShell保持用
    Static psExec  As Object 'As IWshRuntimeLibrary.WshExec
    '取得したScriptControl
    Static scrCtrl As Object 'As MSScriptControl.ScriptControl
    
    
'PowerShellからコールバックされた時はここで抜ける
    If Not ioScrCtrl Is Nothing _
       And VBA.TypeName(ioScrCtrl) = TYPE_NAME Then
        
        Set scrCtrl = ioScrCtrl
        Set GetScriptCtrl = ioScrCtrl
        Exit Function
    End If
    
    
'オブジェクト生存確認。未初期化ならNothing、PowerShellが終了している場合はObject
'取得済みならここで抜ける
    If VBA.TypeName(scrCtrl) = TYPE_NAME Then
        Set GetScriptCtrl = scrCtrl
        Exit Function
    Else
        Set scrCtrl = Nothing   '一応明示的に初期化
    End If
    
    
'PowerShellのコマンド文字列生成
    '生成されるPowerShellのコマンド例
        '[Runtime.InteropServices.Marshal]::BindToMoniker("Book1"
        '   ).Application.Run("'Book1'!Module1.GetScriptCtrl",New-Object -ComObject ScriptControl)
        
    Dim cmdTxt As String
    'スイッチの設定:ウィンドウ非表示、実行後終了しない
    cmdTxt = ps32Path & " -WindowStyle Hidden -NoExit -Command "
    
    'このブックを取得 ≒ GetObject(Excel.ThisWorkbook.FullName) と同じような動作
    cmdTxt = cmdTxt & "[System.Runtime.InteropServices.Marshal]::BindToMoniker('"
    cmdTxt = cmdTxt & Excel.ThisWorkbook.FullName
    
    'Excel.Application.Run
        'ブック名のエスケープに「'」を使うので[Convert]::ToChar(39)で生成
        ' .Run("'ブック名'!モジュール名.プロシージャ名" の形式
    cmdTxt = cmdTxt & "').Application.Run([Convert]::ToChar(39) + '"
    cmdTxt = cmdTxt & Excel.ThisWorkbook.Name
    cmdTxt = cmdTxt & "' + [Convert]::ToChar(39) + '!"
    cmdTxt = cmdTxt & MODULE_PROC
    
    'コールバックで渡すオブジェクトの生成
        'New-Object -ComObject ~
    cmdTxt = cmdTxt & "',(New-Object -ComObject "
    cmdTxt = cmdTxt & PROG_ID
    cmdTxt = cmdTxt & "))"""
    
    'PowerShell実行
    Set psExec = VBA.CreateObject("WScript.Shell").Exec(cmdTxt)

    'PowerShellがコールバックするまで待機
    Dim i As Long
    Do While scrCtrl Is Nothing
        DoEvents: i = i + 1

        '無限ループ防止用。作者環境では5000弱はループする。
        If i > 100000 Then Err.Raise 429
        '429 = ActiveXコンポーネントはオブジェクトを生成できません。
    Loop
    'Debug.Print i   'ループ回数確認用

    '必要に応じて
    'scrCtrl.SitehWnd = Excel.Application.Hwnd
    Set GetScriptCtrl = scrCtrl

End Function

動作確認用コード

上記コードを任意のExcelのブックのModule1という名前のモジュールにコピペし、以下のプロシージャを実行する。

Sub ScrCtrlfor64bitTest()
    Dim myScrCtrl As Object 'As MSScriptControl.ScriptControl
    Set myScrCtrl = GetScriptCtrl
    With myScrCtrl
        .Language = "VBS"
        .ExecuteStatement "MsgBox ""てすと"", vbOKCancel"
    End With
    
    '参照設定をしているのなら
    'Debug.Print TypeOf myScrCtrl Is MSScriptControl.ScriptControl
    '->True
    
End Sub

実行すると一瞬PowerShellの画面が開いたあと、メッセージボックスが表示される。

注意事項

PowerShell起動のオーバーヘッド

初回実行時はPowerShellを起動するため、起動完了までの時間がかかる。
2回目以降は取得したオブジェクトを使い回すため通常通り。

オブジェクトの寿命

生成したオブジェクトはPowerShellが終了すると使用できなくなる。
そのため、-NoExitを指定してPowerShellが閉じないようにしている。

同じインスタンスを使い回す

前記の点を踏まえて、一度オブジェクトを取得したあとは使い回している。
複数のインスタンスが欲しい場合は改造が必要となる。

ローカル環境依存の設定

32bit版PowerShellへのパスや現在のモジュールなど、コードに直接埋め込まれている設定が多いため、適宜修正が必要。

補足

PowerShellは自動で閉じる

WshExecオブジェクトの参照が解放された段階でPowerShellも自動で閉じられるため、裏で増殖することはない。

参考

JScriptの一部処理を使いたい、という場合なら

64ビット環境でのScriptControlの代わり

の方がシンプルになります。

12
11
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
12
11

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?