#VBA100本ノック 96本目

エクセルの神髄 の中の人がツイッターで行っている VBA100本ノック の96本目の解答記事です。

自分が見た範囲の解答ではADODB.Commandによるパラメータ挿入を使っている例を見なかったので、自身の確認も兼ねての解答です。

Public Sub VBA100Knock66()
    '配布されているデータを、同じ場所に保存している前提です。
        'https://twitter.com/yamaoka_ss/status/1365174893566849025
    Dim dbFullName As String
    dbFullName = ThisWorkbook.Path & "\DB1.accdb"
    
    '出力先を事前にきれいにしておきます。
    Dim outputSheet As Excel.Worksheet
    Set outputSheet = ThisWorkbook.Worksheets.Item(1)
    outputSheet.Cells.Delete
    
    
'ADODB の接続部分の設定。
    Dim conn As ADODB.Connection
    Set conn = VBA.Interaction.CreateObject("ADODB.Connection")
    conn.Provider = "Microsoft.ACE.OLEDB.16.0"
    With conn.Properties
        .Item("Data Source").Value = dbFullName
        .Item("Extended Properties").Value = GuessIsamType(dbFullName) & ";"
    End With
    
    conn.Open
    
'ADODB.Command で SQL を設定する。
    Dim cmd As ADODB.Command
    Set cmd = VBA.Interaction.CreateObject("ADODB.Command")
    Set cmd.ActiveConnection = conn
    cmd.CommandType = adCmdText
    
    Dim sqlCmd As String
    sqlCmd = _
        "SELECT " & _
            "[T売上].[取引先CD], " & _
            "[M取引先].[取引先名], " & _
            "[T売上].[商品CD], " & _
            "[M商品].[商品名], " & _
            "[T売上].[単価], " & _
            "[T売上].[数量], " & _
            "[T売上].[単価] * [T売上].[数量] AS [金額]" & _
        "FROM (" & _
            "([T売上] LEFT JOIN [M取引先] ON [T売上].[取引先CD] = [M取引先].[取引先CD]) " & _
                "LEFT JOIN [M商品] ON [T売上].[商品CD] = [M商品].[商品CD]" & _
            ")" & _
        "WHERE " & _
            "[T売上].[日付] >= [以降を抽出したい売上日] AND " & _
            "[T売上].[単価] * [T売上].[数量] >= [最低金額]"
    cmd.CommandText = sqlCmd
    
    'https://twitter.com/yamaoka_ss/status/1365174782161952775
    '■抽出条件
        '2021年以降(2021/01/01~)
        '金額が100万以上
    cmd.Parameters.Append cmd.CreateParameter("以降を抽出したい売上日", adDate, Value:=VBA.DateTime.DateSerial(2021, 1, 1))
    cmd.Parameters.Append cmd.CreateParameter("最低金額", adInteger, Value:=10 ^ 6)
    
    Dim rs As ADODB.Recordset
    Set rs = cmd.Execute()
    
'Excel へ出力する用に各種情報を取得。
    Dim headerNames() As Variant
    ReDim headerNames(0 To rs.Fields.Count - 1)
    Dim i As Long
    i = LBound(headerNames)
    Dim f As ADODB.Field
    For Each f In rs.Fields
        headerNames(i) = f.Name
        i = i + 1
    Next f
    
    Dim dbData() As Variant
    dbData = outputSheet.Application.WorksheetFunction.Transpose(rs.GetRows(Fields:=headerNames))
    
'ここで DB との接続は切っておく。
    rs.Close
    conn.Close
    
    
'Excel にテーブルとして出力。
    With outputSheet.ListObjects.Add(xlSrcRange, outputSheet.Cells.Item(1))
        .HeaderRowRange.Resize(, UBound(headerNames) - LBound(headerNames) + 1).Value() = headerNames
        
        .HeaderRowRange.Offset(1).Resize(UBound(dbData, 1) - LBound(dbData, 1) + 1) = dbData
        
        .Range.Columns.AutoFit
    End With
End Sub


'ファイルの拡張子から、ISAM 形式を類推する(簡易版)。
Private Function GuessIsamType(ByVal inFileName As String) As String
    Dim dotPos As Long
    dotPos = VBA.Strings.InStrRev(inFileName, ".")
    If dotPos = 0 Then Exit Function
    
    Dim ext As String
    ext = VBA.Strings.LCase$(VBA.Strings.Mid$(inFileName, dotPos + 1))
    Select Case ext
        Case "accdb": Let GuessIsamType = ""
        Case "xlsx": Let GuessIsamType = "Excel 12.0 Xml"
    End Select
End Function

#VBA100本ノック 66本目

エクセルの神髄 の中の人がツイッターで行っている VBA100本ノック の66本目の解答記事です。

'Shell.Application を使った再帰ファイル探索処理及び、
'ADODB.Recordset を使ったセル出力のサンプル。
'ExcelのVBA上で実行し、出力先のワークシートを最前面にしていること。

'必要な参照設定。
'Imports Shell32 = Microsoft Shell Controls And Automation
'Imports ADODB   = Microsoft ActiveX Data Objects 6.1 Library

Public Sub VBA100Knock66()
'https://twitter.com/yamaoka_ss/status/1349222275820605442
'https://excel-ubara.com/vba100/VBA100_066.html
    
    Dim appShell As Shell32.Shell
    Set appShell = VBA.Interaction.CreateObject("Shell.Application")
    
    Dim rs As ADODB.Recordset
    Set rs = RecurseFileSeacrh( _
            appShell.Namespace(ThisWorkbook.Path), _
            ThisWorkbook.Name _
        )
    
    '自身を除外する。
    rs.Filter = "[Path] <> #" & ThisWorkbook.FullName & "#"
    If rs.RecordCount = 0 Then Exit Sub
    
    
    Dim ws As Excel.Worksheet
    Set ws = ActiveCell.Worksheet
    
    'Recordset のフィールド数と同じ列数のテーブルを作成。
    With ws.ListObjects.Add(xlSrcRange, ws.Cells.Resize(1, rs.Fields.Count), , xlYes)
        With .HeaderRowRange
            Dim recordFieldNames() As Variant
            recordFieldNames = NamesOfField(rs.Fields)
            
            'ヘッダーにフィールド名を設定。
            .Value() = recordFieldNames
            
            'データ範囲に Recordset の最初から以降全部の値を設定。
            .Offset(1).Resize(rs.RecordCount).Value() = _
                .Application.WorksheetFunction.Transpose( _
                    rs.GetRows( _
                        Rows:=ADODB.GetRowsOptionEnum.adGetRowsRest, _
                        Start:=ADODB.BookmarkEnum.adBookmarkFirst, _
                        Fields:=recordFieldNames _
                    ) _
                )
        End With '.HeaderRowRange
        
        '大きさ調整。
        With .Range
            .ColumnWidth = 100
            .Rows.AutoFit
            .Columns.AutoFit
        End With
    End With
End Sub

'汎用性は低い。
'inDirectory        :検索の起点となる Shell32.Folder3 オブジェクト。Shell32.Shell の Namespace メソッドなどで取得できる。
'inFileNamePattern  :探索したいファイル名のパターン。FolderItems3.Filter に渡されるので動作はよく確認すること。
'refRecordset       :省略可。結果を格納する ADODB.Recordset。既存の Recordset に結果を追記したい場合は設定する。
Private Function RecurseFileSeacrh( _
                 ByVal inDirectory As Shell32.Folder3, _
                 ByVal inFileNamePattern As String, _
        Optional ByRef refRecordset As ADODB.Recordset _
    ) As ADODB.Recordset
    
    '返り値の Recordset の用意。
    If refRecordset Is Nothing Then
        Set refRecordset = VBA.Interaction.CreateObject("ADODB.Recordset")
        With refRecordset.Fields
            .Append "Path", adBSTR
            .Append "ModifyDate", adDate
            .Append "Size", adInteger
        End With
        refRecordset.Open
    End If
    Set RecurseFileSeacrh = refRecordset
    
    
    'FolderItems3.Filterの1個目の引数に指定する定数。
        'https://docs.microsoft.com/en-us/windows/win32/api/shobjidl_core/ne-shobjidl_core-_shcontf
    Const SHCONTF_FOLDERS = &H20&       'フォルダのみを探す場合。
    Const SHCONTF_NONFOLDERS = &H40&    'ファイルのみを探す場合。
    
    'inDirectory 直下のファイル・フォルダ群の一覧を取得。
    Dim itms As Shell32.FolderItems3
    Set itms = inDirectory.Items()
    
    '名前が inFileNamePattern に一致するファイルのみにする。
        'ワイルドカードを考慮しなくていいのであれば`inDirectory.ParseName()`を使う手もある。
    itms.Filter SHCONTF_NONFOLDERS, inFileNamePattern
    
    '中の要素を列挙して Recordset に追加。
    Dim f As Shell32.FolderItem
    For Each f In itms
        Call refRecordset.AddNew( _
            VBA.[_HiddenModule].Array("Path", "ModifyDate", "Size"), _
            VBA.[_HiddenModule].Array(f.Path, f.ModifyDate, f.Size) _
        )
    Next f
    
    'フォルダーのみにフィルター。
    itms.Filter SHCONTF_FOLDERS, "*"
    
    '各フォルダーについて再帰。
    For Each f In itms
        Call RecurseFileSeacrh( _
                f.GetFolder, _
                inFileNamePattern, _
                refRecordset _
            )
    Next f
End Function


'Field の Name を格納した配列を作成する(簡易版)。
Private Function NamesOfField(ByVal inFields As ADODB.Fields) As Variant()
    Dim v() As Variant
    ReDim v(0 To inFields.Count - 1)
    
    Dim i As Long
    i = LBound(v)
    Dim f As ADODB.Field
    For Each f In inFields
        v(i) = f.Name
        i = i + 1
    Next f
    
    Let NamesOfField = v
End Function

その他関連ツイート

.NET Core で Marshal.GetActiveObject を再現してみたときのメモ

.NET Core には Marshal.GetActiveObject(String) メソッド (System.Runtime.InteropServices) | Microsoft Docs が存在しないため、試しに自分で実装してみたときのメモ。

なお、後から「そういえばリファレンスソースがあったよな…?」とおもって確認してみたら、Marshal.GetActiveObjectの部分もあったので、 下手に手実装せず、リファレンスソースをベースにした方がいいとは思います。

referencesource.microsoft.com


自分が作成したコード

Windows PowerShell 5.1、PowerShell Core 7.0 のどちらのAdd-Typeでも問題無く使用できることは確認。

using System;
using System.ComponentModel;
using System.Runtime.InteropServices;

namespace Example.Example /* いい感じに変えること */
{
    public static class COMSupport
    {
        public static object GetActiveObject(string progID)
        {
            const int S_OK = 0x0000;
            Guid clsId = Guid.Empty;
            if (S_OK != NativeMethods.CLSIDFromString(progID, out clsId))
            {
                throw new Win32Exception();
            }
            object com;
            if (S_OK != NativeMethods.GetActiveObject(clsId, IntPtr.Zero, out com))
            {
                throw new Win32Exception();
            }
            return com;
        }
        private static class NativeMethods
        {
            /// <summary>
            /// Retrieves a pointer to a running object that has been registered with OLE.
            /// </summary>
            /// <param name="rclsid">The class identifier (CLSID) of the active object from the OLE registration database.</param>
            /// <param name="pvReserved">Reserved for future use. Must be null.</param>
            /// <param name="ppunk">The requested active object.</param>
            /// <returns>If this function succeeds, it returns S_OK. Otherwise, it returns an HRESULT error code.</returns>
            /// <see cref="https://docs.microsoft.com/ja-jp/windows/win32/api/oleauto/nf-oleauto-getactiveobject"/>
            [DllImport(
                "oleaut32.dll",
                EntryPoint = "GetActiveObject", 
                CallingConvention = CallingConvention.Winapi,
                ExactSpelling = true,
                PreserveSig = true,
                SetLastError = true
            )]
            public static extern int GetActiveObject(
                [MarshalAs(UnmanagedType.LPStruct), In] Guid rclsid,
                [In] IntPtr pvReserved /* = System.IntPtr.Zero */,
                [MarshalAs(UnmanagedType.Interface), Out] out object ppunk
            );

            /// <summary>
            /// Converts a string generated by the StringFromCLSID function back into the original CLSID.
            /// </summary>
            /// <param name="lpsz">The string representation of the CLSID.</param>
            /// <param name="pclsid">A pointer to the CLSID.</param>
            /// <returns>This function can return the standard return value E_INVALIDARG, as well as the following values.</returns>
            [DllImport(
                "ole32.dll",
                EntryPoint = "CLSIDFromString",
                CallingConvention = CallingConvention.Winapi,
                CharSet = CharSet.Unicode,
                ExactSpelling = true,
                PreserveSig = true, 
                SetLastError = true
            )]
            public static extern int CLSIDFromString(
                [MarshalAs(UnmanagedType.LPWStr), In] string lpsz,
                [MarshalAs(UnmanagedType.Struct), Out] out Guid pclsid
            );
        }
    }
}

リファレンスソースとの違い

ProgID→CLSID変換方法

DLL関数の方の GetActiveObjectではオブジェクトの取得に、慣れ親しんだProgID(Excel.Applicationとか。人がオブジェクトを指定するためのもの)ではなく、CLSID(Windowsが対象を認識するためのID。GUID形式)を指定する。

そのProgIDからCLSIDの変換に使用しているDLL関数が異なっていた。

リファレンスソースは、CLSIDFromProgIDExを使用し、自分はCLSIDFromStringを使用している。

名前からするに、本来はCLSIDFromProgIDExを使うべきだが「レジストリを変更します」的な雰囲気の文言があったため、 VBAでExcelを使う - QiitaでProgIDからCLSIDへの変換に使われていたCLSIDFromStringを使用した。

.NET Framework内部でCLSIDFromProgIDExを使っている以上、それでいい気がするけれど、なんとなく気分の問題。

DLL関数のPreserveSigの設定

今回使用しているDLL関数はHRESULT(成功や失敗の理由を示す整数値)の返り値を返す。

このような場合に、DllImportPreserveSig フィールドfalseにし、返り値をvoidに変更するとDLL関数エラー時に自動でC#の例外に変換してくれる。

要するにPreserveSig = falseとしてDLL関数の返り値をvoidにすると、以下のように書いているところがただの呼び出しでOKになる。

if (S_OK != NativeMethods.CLSIDFromString(progID, out clsId))
{
    throw new Win32Exception();
}

ちゃんと書こうと思って、PreserveSig = trueとしたけれど、結局エラーにする以上trueにしても良かった気がする(usingで指定するものも減る)。

はまったこと

Guidを返り値で受け取る時のMarshalAsの定義

Guidを入力で使うときは[MarshalAs(UnmanagedType.LPStruct)]を付けるとよい、と聞いていたので 返り値の方にも間違えて付けてしまったところ、メモリアクセス違反のエラーでプロセスが落ちてしまった。

入力として渡す分には、ポインタを渡して参照してもらえればいいけれど、出力として貰う場合は[MarshalAs(UnmanagedType.Struct)]とする必要があった。

参照への参照の表現方法

DLL関数のGetActiveObjectの定義は以下のようになっており、ppunkIUnknown(COMオブジェクト)へのポインタのポインタ(参照への参照)となっている。

HRESULT GetActiveObject(
  REFCLSID rclsid,
  void     *pvReserved,
  IUnknown **ppunk
);

VBAであれば、ByRefでObject型を渡すように定義すればOKなので、C#でもそのままref object ppunkのように定義したら、以下のようなエラーが発生してしまった。

Specified OLE variant is invalid.
指定された OLE 変数が無効です。

適当に試したところ、以下のどちらかの方法であればCOMオブジェクトへの参照への参照を表現出来るようだった。

ref IntPtr ppunkとして、Marshal.GetObjectForIUnknownで変換する

まずは、COMオブジェクトへの参照として、ポインタIntPtrでやりとりし、取得したポインタをMarshal.GetObjectForIUnknownでCOMオブジェクトにする、という方法。

[MarshalAs(UnmanagedType.Interface)]を指定する

UnmanagedType.Interfaceを指定することで、その引数がCOMの型と認識され自動でCOMオブジェクトとしてくれる。 今回は引数をobjectで定義しているためUnmanagedType.IUnknownでも問題はない。

参考

GetActiveObject function (oleauto.h) - Win32 apps | Microsoft Docs
Marshal.GetActiveObject のリファレンスソース
GetActiveObject function (oleauto.h) - Win32 apps | Microsoft Docs
CLSIDFromProgIDEx function (combaseapi.h) - Win32 apps | Microsoft Docs
DllImportAttribute クラス (System.Runtime.InteropServices) | Microsoft Docs
MarshalAsAttribute クラス (System.Runtime.InteropServices) | Microsoft Docs
VBAでExcelを使う - Qiita
【Windows/C#】なるべく丁寧にDllImportを使う - Qiita

ADODB・ADOXを使ってxlsxファイルを作成してみるサンプル

はじめに

VBAでは、Microsoft ActiveX Data Objects X.X Library(ADODB)を使うことで、既存のデータベースに接続して情報を取得したり、SQLを実行できます。

SQL Serverのようなちゃんとしたデータベースだけでなく、ExcelのブックなどもAccessのエンジン経由でデータベースとして扱うことができ、CREATE TABLEなどのSQLを実行することでシートの追加が可能です。

この記事では、SQLを使わず、Microsoft ADO Ext. X.X for DDL and Security(ADOX)を使って、Excelのブックを作成する方法のメモとなります。

ADOX とは?

ActiveX Data Objects(ADO)を構成する機能の一つであり、データベース内のテーブルなどの構成の確認や変更を行えるライブラリです。

docs.microsoft.com

ADOX の基礎 - SQL Server | Microsoft Docs

しかし、ADOの中核であるADODBライブラリに比べると、比較的重要度は低いものになります。 なぜかと言うと、ADOXで行える操作はSQL(CREATE TABLEなど)がわかっていればADODBだけでも実行可能な操作だからです。

その上でADOXを使用するメリットとしては「SQLの構文を知らなくても操作ができる」・「動的に構成を組み立てられる」といったところになります。

操作の流れ

ADOX.Catalogと対象のデータベースを紐付ける

ADOXを使うとは言っても、まずはADODBで(明示的にせよ・暗黙的にせよ)接続を行う必要があります。

CreateObject("ADOX.Catalog")などでCatalogオブジェクトを作成した後、Createメソッドに接続文字列を指定したり、ActiveConnectionプロパティに既存の接続を設定することで紐付けを行えます。

接続文字列などはADODBの基本的な操作であり、多くの記事で紹介されているため、この記事では割愛します。

紐付けすることで、データベース(今回はブック)内部の(ADOとしての)テーブル(ADOX.Table)と認識されるものを管理できるようになります。

Catalogにテーブルを追加

Catalog内のテーブルの一覧(Catalog.Tables)に、自分で作成・定義したADOX.Tableを追加することで、テーブルの追加を行えます。

Excelの場合、テーブルを追加するとそのテーブルの名前のシートと名前付き範囲が追加されます。

ADOX.TableCreateObject("ADOX.Table")などで作成できるため、作成後に名前(Nameプロパティ)や、列の設定(Columns)を行っていきます。

列の追加はTable.Columns.Append "列名", 型でも行えますし、 CreateObject("ADOX.Column")で作成したColumnオブジェクトを追加することもできます。

サンプル

Public Declare PtrSafe Sub Sleep Lib "kernel32.dll" ( _
        Optional ByVal dwMillisecond As Long = 0 _
    )

'以下の二つの参照設定が必要。

'Imports ADODB = Microsoft ActiveX Data Objects X.X Library
'Imports ADOX  = Microsoft ADO Ext. X.X for DDL and Security


Sub Sample_CreateXlsxByADOX()
'動作の流れ
'1. ブックへの接続を確立
'2. ブック内の(ADOとしての)テーブルの作成 or 取得
'3. テーブルへの情報の設定

'1. ブックへの接続を確立
    
    '作成・追記するExcelブックへのパス(動作確認は.xls, .xlsx, .xlsbのみ)。
    Dim destPath As String
    destPath = VBA.Interaction.Environ$("USERPROFILE") & "\Documents\新しいフォルダー\sample.xlsx"
    
    'Excelのブックへの接続を用意。
    Dim cnn As ADODB.Connection
    Set cnn = CreateAceExcelConnection(destPath)
    
    
'2. ブック内の(ADOとしての)テーブルの作成 or 取得
    
    'データソース内の情報を管理するオブジェクトを作成。
    Dim ctlg As ADOX.Catalog
    Set ctlg = VBA.Interaction.CreateObject("ADOX.Catalog")
    '上記で作成した接続と紐付け。
    Set ctlg.ActiveConnection = cnn
    

    '作成・追記する範囲。
        '指定した名前付範囲があればそれを、無ければ新規シートが作成される。
    Dim tableName As String
    tableName = "Test"
    
    'tableNameと一致するテーブルを探す。
    Dim tbl As ADOX.Table
    For Each tbl In ctlg.Tables
        If tbl.Name = tableName Then _
            Exit For 'TODO:Excel独自動作もあるため、よく動作検証すること。
    Next tbl
    
    If tbl Is Nothing Then
        'テーブルが見つからなかったら定義する。
        Set tbl = VBA.Interaction.CreateObject("ADOX.Table")
        tbl.Name = tableName
        With tbl.Columns
            .Append "秒", adInteger
            .Append "文字", adLongVarWChar
        End With
        ctlg.Tables.Append tbl
    End If
    
    '閉じる必要は無いけれど、動きを見せるために一旦閉じてブックを開く。
    cnn.Close
    Shell "explorer.exe " & destPath
    Sleep 5000
    Set cnn = CreateAceExcelConnection(destPath)
    
    
'3. テーブルへの情報の設定
    Dim rs As ADODB.Recordset
    Set rs = VBA.Interaction.CreateObject("ADODB.Recordset")
    rs.Open tbl.Name, cnn, adOpenForwardOnly, adLockOptimistic
    
    Dim i As Long
    For i = VBA.Strings.AscW("A") To VBA.Strings.AscW("z")
        rs.AddNew
        With rs.Fields
            .Item(0) = Second(Time)
            .Item(1) = VBA.Strings.String$(i / 5, i)
        End With
        rs.Update
        Sleep 300
    Next i
    
    cnn.Close
End Sub


'inDataSourceをExcelのファイルと見なして接続するADODB.Connectionを作成する。
'「Microsoft.ACE.OLEDB.12.0」を使用するため、Accessのエンジンが必要。

'引数
    'inDataSource       :対象のExcelブックのパス(実行時に存在していなくても可)。
    'inMode             :接続モードを指定する。既定値はadModeShareDenyNone。
    'inCursorLocation   :カーソルの管理をどちらがするかを指定する。既定値はadUseServer。
'返り値
    '引数の状態を元にOpenされたADODB.Connection。
Function CreateAceExcelConnection( _
                 inDataSource As String, _
        Optional inMode As ADODB.ConnectModeEnum = ADODB.ConnectModeEnum.adModeShareDenyNone, _
        Optional inCursorLocation As ADODB.CursorLocationEnum = ADODB.CursorLocationEnum.adUseServer _
    ) As ADODB.Connection
    
    Dim cnn As ADODB.Connection
    Set cnn = VBA.Interaction.CreateObject("ADODB.Connection")
    'Accessのエンジンを使用する。
    cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
    With cnn.Properties
        '接続先のファイルパス(この時点で存在していなくてもOK)。
        .Item("Data Source").Value = inDataSource
        
        'ISAM形式などを指定する(Excelの場合、ヘッダー行のチェックなども指定できる)。
            'ExcelのISAM形式は既存の物を読み込む場合は、多少適当でもいいけど
            '新規作成時は適したタイプを指定する必要がある。
        .Item("Extended Properties").Value = GuessIsamTypeByExtension(inDataSource)
    End With
    
    cnn.CursorLocation = inCursorLocation
    cnn.Mode = inMode
    cnn.Open
    Set CreateAceExcelConnection = cnn
End Function

'inDataSourceの拡張子からISAMタイプを推測する。
Function GuessIsamTypeByExtension(inDataSource As String) As String
    Dim retIsamType As String
    
    Dim fso As Object 'As Scripting.FileSystemObject
    Set fso = VBA.Interaction.CreateObject("Scripting.FileSystemObject")
    
    Select Case VBA.Strings.LCase$(fso.GetExtensionName(inDataSource))
        Case "xls":     retIsamType = "Excel 8.0"
        Case "xlsx":    retIsamType = "Excel 12.0 Xml"
        Case "xlsm":    retIsamType = "Excel 12.0 Macro"
        Case "xlsb":    retIsamType = "Excel 12.0"
        Case "xlt", "xla", "xltx", "xlam"
            'TODO:未確認(新規作成は不可)
            Err.Raise 5, , "Not supported type." & inDataSource
        Case Else
            'TODO:Accessやcsv、txtなどの対応。
            Err.Raise 5, , "Not supported type." & inDataSource
    End Select
    
    Let GuessIsamTypeByExtension = retIsamType
End Function

動作イメージ

UI Automation用 SendKeysラッパー関数 (PowerShell)

概要

個人的に作っている UI Automation 関数群を、記憶を元に再構築、リファインした物の一部。

指定した要素にSendKeysをするだけのもの。 Pattern が使えれば不要なことは多いが、たまに必要になることも……。

この記事における UI Automation

.NET Framework の System.Windows.Automation 名前空間で定義されているもののこと。

動作確認環境

WIndows 10 Pro 64bit Windows PowerShell 5.1

コード

github.com

# 使用するアセンブリや名前空間の指定(PowerShell 5.1以降の機能)
using namespace System

# UIAutomation 関連のアセンブリ群
using assembly  UIAutomationClient
using assembly  UIAutomationTypes
using assembly  UIAutomationClientSideProviders
using namespace System.Windows.Automation

# SendKeys 用のアセンブリ
using assembly  System.Windows.Forms
using namespace System.Windows.Forms

function Send-UIAKeys {
<#
.SYNOPSIS
対象の要素にキーストロークを送信します。
.DESCRIPTION
$InputObjectで指定された要素にキーストロークを送信します。
System.Windows.Forms.SendKeys.SendWaitを使用するため、アクティブなウィンドウが変更されます。
#>
    [CmdletBinding()]
    [OutputType([System.Windows.Automation.AutomationElement])]
    Param(
        
        # キーストロークを送信する要素を指定します。
        # キーボードフォーカスを受け取ることが出来ればフォーカスし、そうでなければ直近の親ウィンドウを最前面にします。
        # このパラメーターは必須です。
        [Parameter(Mandatory = $true, ValueFromPipeline = $true)]
        [AutomationElement]$InputObject
        ,
        # 送信するキーストロークを指定します。
        # System.Windows.Forms.SendKeys クラスと同じ形式で文字列を指定します。
        # https://docs.microsoft.com/ja-jp/dotnet/api/system.windows.forms.sendkeys?view=netframework-4.8
        # このパラメーターは必須です。
        [Parameter(Mandatory = $true)]
        [string]$Keys
        ,
        # キーストローク送信後待機する時間をミリ秒単位で指定します。
        # $RestoreFocus スイッチを指定する場合は意図した動作になるよう調整が必要です。
        [ValidateRange(0, [int]::MaxValue)]
        [Alias('ms')]
        [int]$WaitMilliseconds = 0
        ,
        # キーストローク送信後、フォーカスを直前の要素に戻します。
        # 既定では、キーストロークを送信した要素が最前面となります。
        # 指定する場合、$WaitMilliseconds の値も適切な値に変更する必要があります。
        # この関数を連続して実行する場合、期待した結果が得られないことがあります。
        [switch]$RestoreFocus
        ,
        # $InputObject を再度パイプラインに出力します。
        # 既定では、この関数による出力はありません。
        [switch]$PassThru
    )

    Process {
        # 現在のフォーカスを取得。
        [AutomationElement]$currentFocus = [AutomationElement]::FocusedElement
        

        # 親ウィンドウを取得するため、WindowPatternを実装している要素を探すTreeWalkerを作成。
        [TreeWalker]$windowWalker = [TreeWalker]::new(
            [PropertyCondition]::new(
                [AutomationElement]::IsWindowPatternAvailableProperty, 
                $true
            )
        )

        # 親ウィンドウ取得。
        [AutomationElement]$parentWin = $windowWalker.Normalize($InputObject)
        if ($null -eq $parentWin) {
            # 取得できなかった場合は強制停止。
            $PSCmdlet.ThrowTerminatingError([Management.Automation.ErrorRecord]::new(
                [InvalidOperationException]::new('親ウィンドウを取得できません。'),
                'ParentWindowNotFound',
                [Management.Automation.ErrorCategory]::NotEnabled,
                $InputObject
            ))
        }

        # フォーカスの変更。
        # WindowPattern.SetWindowVisualState(最大化・最小化などの変更)を行うと、
        # 現在の状態にかかわらずそのウィンドウが最前面になることを利用。
        [WindowPattern]$winPtn = $parentWin.GetCurrentPattern([WindowPattern]::Pattern)
        [WindowVisualState]$visState = $winPtn.Current.WindowVisualState
        if ($visState -eq [WindowVisualState]::Minimized) {
            # 最小化されている場合は通常に戻す。
            $visState = [WindowVisualState]::Normal
        }
        $winPtn.SetWindowVisualState($visState)

        if ($parentWin.Current.IsKeyboardFocusable) {
            $parentWin.SetFocus()
        }
        if ($InputObject.Current.IsKeyboardFocusable) {
            $InputObject.SetFocus()
        }
        
        # キーストローク送信。
        [SendKeys]::SendWait($Keys)

        # 送信後の待機。
        while (-not $winPtn.WaitForInputIdle($WaitMilliseconds)) {
        }
        Start-Sleep -Milliseconds $WaitMilliseconds


        if ($RestoreFocus) {
            # フォーカスを戻す。
            $currentFocus.SetFocus()
        }
    }
}

動作イメージ

Start-Processで起動したメモ帳に九九の表を入力するコード。 Start-Processの代わりにGet-Processなどで Excel を取得しても動作する。

f:id:imihito:20191118235344g:plain
Send-UIAKeys動作イメージ

using namespace System
using namespace System.Diagnostics

using assembly  UIAutomationClient
using assembly  UIAutomationTypes
using assembly  UIAutomationClientSideProviders
using namespace System.Windows.Automation

[Process]$targetProc = Start-Process -FilePath notepad -PassThru
$targetProc.WaitForInputIdle()

[AutomationElement]$uiaTarget = [AutomationElement]::FromHandle($targetProc.MainWindowHandle)

for ($r = 1; $r -le 9; ++$r) {
    for ($c = 1; $c -le 9; ++$c) {
        # 引数指定で実行。
        Send-UIAKeys -InputObject $uiaTarget -Keys "$($r * $c){TAB}"
    }
    # パイプライン入力で実行。
    $uiaTarget | Send-UIAKeys -Keys "{ENTER}"
}

UI AutomationでExcelのセルを操作してみたかった(未完)

メモ程度。

このツイートの内容の確認に使用したコード。

<#
.Synopsis
# UI Automation でExcelのセルの値を取得するサンプル
## 前提条件
- Excelを起動し、何かブックを開いていること
- Windows 10 の Windows PowerShell ISE で実行すること
#>

# 実行に必要なアセンブリ類のロード
using assembly  UIAutomationClient
using assembly  UIAutomationTypes
using assembly  UIAutomationClientSideProviders
using namespace System.Windows.Automation

# Excelのウィンドウを取得。
# 今のデスクトップのルートの子どもから「XLMAIN」というクラス名の要素を探索。
[AutomationElement]$uiaXl =
    [AutomationElement]::RootElement.FindFirst(
        [TreeScope]::Children,
        [PropertyCondition]::new([AutomationElement]::ClassNameProperty, 'XLMAIN')
    )

# 取得したExcelのウィンドウ配下からテーブルとしての機能を持つ要素を探索。
[AutomationElement]$uiaCellTable = 
    $uiaXl.FindFirst(
        [TreeScope]::Descendants, 
        [PropertyCondition]::new([AutomationElement]::IsTablePatternAvailableProperty, $true)
    )

# テーブルとしての機能を使えるようにする。
[TablePattern]$ptnTable = $uiaCellTable.GetCurrentPattern([TablePattern]::Pattern)

# 今見えている範囲の左上から3,3の位置の要素を取得する(行・列見出しも含めて数える/左上がA1でない場合はB2ではない)。
[AutomationElement]$uiaB2 = $ptnTable.GetItem(2, 2)
<# 持っている機能の確認
PS > $uiaB2.GetSupportedPatterns()
   Id ProgrammaticName                       
   -- ----------------                       
10002 ValuePatternIdentifiers.Pattern        
10007 GridItemPatternIdentifiers.Pattern     
10010 SelectionItemPatternIdentifiers.Pattern
10013 TableItemPatternIdentifiers.Pattern    
10014 TextPatternIdentifiers.Pattern
#>

# 選択する機能
[SelectionItemPattern]$ptnSel = $uiaB2.GetCurrentPattern([SelectionItemPattern]::Pattern)
$ptnSel.Select() # セルの選択は可能

# 値の取得・設定をする機能
[ValuePattern]$ptnVal = $uiaB2.GetCurrentPattern([ValuePattern]::Pattern)
$ptnVal.Current.Value # セルに表示されている値を出力

<# SetValueでエラーは出ないけど表示に反映されない
$ptnVal.SetValue('Hoge')
$ptnVal.Current.Value # ここの値では反映されている
#>

型を検索する PowerShell 関数(親クラス→子クラス)

はじめに

ネット環境無しで PowerShell を弄っているとたまに起こるのが、「引数に何を渡せば良いのかわからない」問題です。

Get-Member コマンドレットなどで各種メンバーの定義は確認できますが、引数の型が抽象的な型になっていて、具体的な型がわからない、という問題です。

例:System.DateTimeToString メソッド

PS >[datetime]::Now.ToString.OverloadDefinitions

string ToString()
string ToString(string format)
string ToString(System.IFormatProvider provider)
string ToString(string format, System.IFormatProvider provider)
string IFormattable.ToString(string format, System.IFormatProvider formatProvider)
string IConvertible.ToString(System.IFormatProvider provider)

System.IFormatProvider って具体的に何……?」という問題です。

型名の先頭にIが付いていることからインターフェイスということはわかりますが、これだけではその先に繋がりません。

Microsoft Docs を見られれば、派生が書いてあるのでそれでOKなのですが……。 IFormatProvider Interface (System) | Microsoft Docs

対策の方針

今使えるすべての型の中から、該当する型の子クラス(やや不正確な表現)を探索する。

System.AppDomain を使えばロード済みアセンブリを取得できるので、さらにそのアセンブリ内の型を列挙すれば、使えるすべての型を取得できる。

Type.IsAssignableFrom(Type) Method (System) | Microsoft Docs を使えば、該当する型の子クラスかどうかも判定できる。

作成した関数

github.com

<#
.SYNOPSIS
Search type from loaded assemblies.
ロード済みアセンブリー内から型を検索します。
.DESCRIPTION
Search type by root type from Loaded assemblies.
ロード済みアセンブリー内から、指定した型及びサブクラスを検索します。
.EXAMPLE
[System.IFormatProvider] | Search-Type
IsPublic IsSerial Name               BaseType     
-------- -------- ----               --------     
True     False    IFormatProvider                 
True     True     CultureInfo        System.Object
True     True     DateTimeFormatInfo System.Object
True     True     NumberFormatInfo   System.Object
.INPUTS
System.Type
.OUTPUTS
System.Type
By default, return all public type in loaded assemblies.
#>
function Search-Type {
    [CmdletBinding()]
    [OutputType([type])]
    param (
        [Parameter(ValueFromPipeline=$true)]
        [type]$RootType = [System.Object]
        ,
        [SupportsWildcards()]
        [string]$Name
        ,
        [SupportsWildcards()]
        [string]$Namespace
        ,
        [SupportsWildcards()]
        [string]$FullName
    )
    begin {
        # Declare foreach variables for IntelliSense.
        [System.Reflection.Assembly]$asm = [type]$t = $null
    }
    process {
        foreach ($asm in [System.AppDomain]::CurrentDomain.GetAssemblies()) {
            foreach ($t in $asm.GetTypes()) {
                # Public only.
                if (-not $t.IsPublic) { continue }

                if (-not $RootType.IsAssignableFrom($t)) { continue }

                # Name check.
                if (-not [string]::IsNullOrEmpty($Name)      -and ($t.Name      -notlike $Name)      ) { continue }
                if (-not [string]::IsNullOrEmpty($Namespace) -and ($t.Namespace -notlike $Namespace) ) { continue }
                if (-not [string]::IsNullOrEmpty($FullName)  -and ($t.FullName  -notlike $FullName)  ) { continue }

                Write-Output -InputObject $t
            }
        }
    }
}

使用例1

前述のSystem.IFormatProviderを探したい場合は以下のようにする。

PS> [System.IFormatProvider] | Search-Type

IsPublic IsSerial Name               BaseType     
-------- -------- ----               --------     
True     False    IFormatProvider                 
True     True     CultureInfo        System.Object
True     True     DateTimeFormatInfo System.Object
True     True     NumberFormatInfo   System.Object

さらに以下のようにすれば、FullNameも分かるのであとはある程度何とかなる。

PS> [System.IFormatProvider] | Search-Type | Select-Object -ExpandProperty FullName

System.IFormatProvider
System.Globalization.CultureInfo
System.Globalization.DateTimeFormatInfo
System.Globalization.NumberFormatInfo

使用例2

どんなコレクションがあるんだっけ…?と発作的に調べてくなったら以下のようにする(ワイルドカード指定のサンプル)。

PS> [System.Collections.IEnumerable] | Search-Type -Namespace System.Collections*

IsPublic IsSerial Name                             BaseType                                                     
-------- -------- ----                             --------                                                     
True     True     CollectionBase                   System.Object                                                
True     True     DictionaryBase                   System.Object                                                
True     True     ReadOnlyCollectionBase           System.Object                                                
True     True     Queue                            System.Object                                                
True     True     ArrayList                        System.Object                                                
True     True     BitArray                         System.Object                                                
True     True     Stack                            System.Object                                                
True     True     Hashtable                        System.Object                                                
True     False    ICollection                                                                                   
True     False    IDictionary                                                                                   
True     False    IEnumerable                                                                                   
True     False    IList                                         
...