家族用パスワードマネージャーを1PasswordとKeeperで悩んで1Passwordにした話

はじめに

2024年10月末~11月初め頃に、家族で使う用途のパスワードマネージャーとして1PasswordとKeeperを検討していました。 どちらも無料トライアルの範囲で使ってみたところ、1Passwordの方が自分の用途では向いていると感じました。

この記事では、選定の基準や、それぞれで試した範囲の特徴などを記載しています。

1password.com

www.keepersecurity.com

パスワード管理などの基本的な方針

セキュリティはある程度保ちつつ、利便性を重視したい、という考えで検討しています。

例えば、パスワードマネージャーでパスワードと2要素認証のワンタイムコード生成器(TOTP)を兼ねるのは、パスワードマネージャー侵入時のリスクを考えるとセキュリティ面では良くないとは思います。 しかし、2要素認証を設定しないよりはマシであり、OSの自動入力機能を踏まえると兼ねた方が楽な場面があります。 そのため、パスワードマネージャーで両方を管理するという方針としています。

導入以前の状況

自分はWindows/Android/iOS/iPadOSを利用し、パスワード管理はGoogle Chrome(Googleパスワードマネージャー)をメインで使用していました。 家族との共有のため、iCloudキーチェーンによる共有パスワードも利用していました(家族はiOS/iPadOSを主に利用、たまにWindows)。

パスワードマネージャーで解決したかった問題

共有パスワードでは「自分用のアカウント情報で、共有のパスワード情報を上書きしてしまう」と言った事故がたまに発生していました。 そのため、変更履歴などを記録できるものが良いと考えました。

また、パスキーを設定すると、Windows操作中でもスマホでの操作が必要な場面が度々発生し、面倒に感じる場面がありました。 (後から調べると、パスキーを複数端末で設定出来るサービスは多いのでそちらで対応しても良かったかもしれません。一部サービスでは複数設定が難しいものもありますが。)

機能などの比較

1Passwordの決め手になった点

サインイン状況の把握

新規ログインを行うとメールで「サインインアラート」のメールが送付されてきます。 また、現在サインインしている環境の一覧の確認、接続の解除を行うことができます。

Keeperでは直近のアクティビティを確認することはできますが、個人の無料トライアルの範囲では全体を確認する方法が無いようでした。

料金

1Passwordファミリープランは、iOSの年間サブスクリプションの場合、2024/11時点では 6600円/年となります。

Keeper Familyは8000円/年ですが、公式サイトで3年分をまとめて購入すると30% Offとなるため 5600円/年となります。 しかし、パスワード漏洩検知機能のBreachWatchが4640円/年、30% Offでも3248円/年となり、これも追加すると1Passwordよりも料金が高くなってしまいます。

軽く調べた範囲の話ですがKeeperは更新時の料金の考え方もわかりにくく感じました。 例えば、キャンペーンとして1年間50% Offもたびたび行っているようですが、2年目以降は通常料金に戻るとの情報があります。 また3年分をまとめた場合の30% Offも、更新時にどうなるのかも軽く調べた範囲では見つけることができませんでした。

ちなみに1Passwordはソースネクストの3年版を購入することで、もう少し安い値段で利用することができます。 楽天市場で11/4-11/11開催のお買い物マラソンの際は17970円/3年 = 5990/1年となっていました。 item.rakuten.co.jp

自分の場合、購入だけでダメで1Passowrd社にメールを送る必要がある点が面倒に感じたのと、 諸事情により使い道のないAppleストアクレジットが貯まっていたため、iOSの年間サブスクリプションを選択しました。

1Passwordが優れていると感じた点

Safari拡張機能

1Passwordの拡張機能はiOSやiPad OSのSafariでもインストールすることができます。 そのため、モバイル端末でも自動入力に対応できる範囲が広いように感じました。

例えば、ゆうちょダイレクトのログインのお客様番号→ログインパスワードを入力してログイン、が可能になります。

Watchtowerによるセキュリティレベルの提案

1PasswordにはWatchtowerという保存されているパスワードのセキュリティレベルを評価する機能があります。 (Keeperにも相当する機能として「セキュリティ監査」と「BreachWatch」があります)

Watchtowerのユニークな点として、パスキーや2要素認証が設定可能なサイトの数を表示してくれる、というものがあります。 これにより、設定を見直すきっかけにできるのが良いと感じました。

1Password Watchtower

Keeper セキュリティ監査

ログイン時のセキュリティ強度

新規端末などへのログイン時は、メールアドレス・マスターパスワードに加え、SecretKeyという文字列が必要になります。 手元にログイン済みの端末があれば入力を省略できるたりするため、本人が端末を追加する分には手間はそれほど変わりませんが、不正ログインされるリスクを減らすことができます。

Keeperが優れていると感じた点

Androidでのパスワード自動入力の挙動

Keeperの方が強い権限(「ユーザー補助」の権限)を要求するだけあり、パスワード補完時や登録時の動作が良いように感じました。

基本的な機能のマニュアル＆日本語対応

日本法人があるだけあり、ホームページやヘルプなどが基本的に日本語で表示されます。

以下のページはKeeperのヘルプですが、おおよその機能をざっと確認することができます。

docs.keeper.io

好みの問題だが1Passwordの方がよいと感じた点

情報の分類方法

1Passwordはタグを設定して分類することができます。 対して、Keeperではフォルダによる分類となります。

タグの方がいろいろな側面から情報を指定でき、フォルダのような階層構造も作成出来るため、扱いやすいように感じました。 ただ、すでに作成済みのタグを一括で書き換える方法が無さそうなため、大規模な修正には手間がかかりそうです。

Windowsアプリの動作

「クイックアクセス」という機能がある、ショートカットキーからパスワードの一覧を検索し、サイト開いてログインの動作を簡単に行うことができます。 CLIとかに近いイメージの操作感で、1Passwordがギーク向けと言われるのもわかる雰囲気でした。

好みの問題だがKeeperの方がよいと感じた点

緊急アクセス機能

実際には試していません。 5人までユーザーを指定して、緊急時にアカウントの情報を共有できるようにする機能です。 共有対象はKeeperユーザーであればよく、ファミリーの一員に制限されない、というのが優れていると感じました。

その他雑感

機能の説明を見る限りでは、1Passwordのファミリープランは原則家族(5人+ゲスト5人まで)の範囲に閉じていますが、 Keeperは家族の範囲にとどまらず利用できそうなのが特徴に感じました。

そのため、周囲の人がKeeperを使っていればKeeperの方が便利な場面が増えそうに感じました。

#VBA100本ノック 96本目

VBA Excel

エクセルの神髄 の中の人がツイッターで行っている 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本目

Excel VBA

エクセルの神髄 の中の人がツイッターで行っている 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 を再現してみたときのメモ

PowerShell C#

.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(成功や失敗の理由を示す整数値)の返り値を返す。

このような場合に、DllImportのPreserveSig フィールドを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の定義は以下のようになっており、ppunkがIUnknown(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 Excel

はじめに

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.TableもCreateObject("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)

PowerShell UI Automation

概要

個人的に作っている 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のセルを操作してみたかった(未完)

PowerShell 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 # ここの値では反映されている
#>