SendKeysの代替

Access、ExcelVBAやVB6のユーザはSendKeysにバグがあることをご存知の方はかなり多いと思います。私も一応知っていたのですが、どんなバグかはよく知りません。なぜ知らないかというと使わないからです。今後も使うつもりはありません。キッパリ。だいたいキーストークをプログラムとして送信するなんてのは邪道です。異論はいろいろあろうかと思いますが受け付けません。納得できる理由があれば別ですが未だそうゆうものを見かけません。
ただバグのままってのも問題だと思うので、代替法の一つを挙げてみます。
環境は MS-Access2000 + WindowsXPです。

VBエディタを起動してツールバーの挿入(I)→標準モジュールで新しい標準モジュールを追加して以下のコードを記述してください。

Option Compare Database  
Option Explicit  

'(A)仮想キーコード---------------------------------------------------
Public Const VK_SHIFT_UP        As Long = &H10     'ShiftキーUp
Public Const VK_SHIFT_DOWN      As Long = &HF10    'ShiftキーDown
Public Const VK_CONTROL_UP      As Long = &H11     'CtrlキーUp
Public Const VK_CONTROL_DOWN    As Long = &HF11    'CtrlキーDown
Public Const VK_MENU_UP         As Long = &H12     'AltキーUp
Public Const VK_MENU_DOWN       As Long = &HF12    'AltキーDown

Public Const VK_A               As Long = &H41     'A 
' ・
' ・
Public Const VK_F               As Long = &H46     'F 
' ・
' ・
'-------------------------------------------------------------------

'キーボードイベント構造体
Private Type KEYBDINPUT  
    wVk         As Integer  
    wScan       As Integer  
    dwFlags     As Long  
    time        As Long  
    dwExtraInfo As Long  
End Type  

'キーストローク状態定数(KEYBDINPUT構造体のdwFlagsで指定)
Private Const KEYEVENTF_EXTENDEDKEY As Long = &H1  
Private Const KEYEVENTF_KEYUP       As Long = &H2  
Private Const KEYEVENTF_UNICODE     As Long = &H4  
Private Const KEYEVENTF_SCANCODE    As Long = &H8  

'(B)キーボード／マウス入力情報用構造体
Private Type INPUTS  
    type        As Long  
    ki          As KEYBDINPUT  
    reserved(7) As Byte     'キーボードイベント用サイズ調整
                            '(KEYBDINPUTとMOUSEINPUTのサイズの差)
End Type 

'入力タイプ定数(INPUTS構造体のtypeメンバで指定)
Private Const INPUT_MOUSE           As Long = 0  
Private Const INPUT_KEYBOARD        As Long = 1  
Private Const INPUT_HARDWARE        As Long = 2  

'キーストローク/マウス入力送信
Private Declare Function SendInput Lib "user32.dll" _  
                                  (ByVal nInputs As Long, _  
                                   pInputs As INPUTS, _  
                                   ByVal cbSize As Long) As Long  

'キーストロークアクションの種類
Private Enum KEY_ACTION  
    KEY_BOTH     'KEY_DOWN + KEY_UP 
    KEY_DOWN 
    KEY_UP 
End Enum  

'-----------------------------------------------------------------------
'キーストローク送信
'引数 argvKeys 仮想キーコードの配列  
'戻値 送信したキーイベント数 
Public Function SimpleSendKeys(ParamArray argvKeys() As Variant) As Long
    Dim vlSpecialKey    As Long  
    Dim i               As Long  
    Dim vtKb()          As KEYBDINPUT  
    Dim vtInputs()      As INPUTS  

    On Error Resume Next  

    For i = LBound(argvKeys) To UBound(argvKeys)  

        vlSpecialKey = argvKeys(i) And &HFF  

        'Alt, Ctrl, Shiftキーのいずれかの時 
        If vlSpecialKey <= VK_MENU_UP And vlSpecialKey >= VK_SHIFT_UP Then

            'vtKbのデータ作成 
            PrcCreateKBInput vtKb, _  
                             vlSpecialKey, _  
                             IIf((argvKeys(i) And &HF00) > 0, KEY_DOWN, KEY_UP)
        Else 
            'vtKbのデータ作成 
            PrcCreateKBInput vtKb, argvKeys(i), KEY_BOTH  
        End If  

    Next i  

    'INPUTS構造体配列作成 
    ReDim vtInputs(UBound(vtKb))  

    'INPUTS構造体各データ作成 
    For i = LBound(vtInputs) To UBound(vtKb)  
        vtInputs(i).type = INPUT_KEYBOARD  
        vtInputs(i).ki = vtKb(i)  
    Next i  

    'キーストローク送信 
    SimpleSendKeys = SendInput(UBound(vtInputs) + 1, vtInputs(0), LenB(vtInputs(0)))

End Function  

'KEYBDINPUT構造体生成
'引数 argtKb      キーボードイベントの結果を受取る配列  
'     arglKey     キー入力の仮想キーコード  
'     argeStatus  キーストロークのアクションの種類 
Private Sub PrcCreateKBInput(argtKb() As KEYBDINPUT, _  
                             ByVal arglKey As Long, _  
                             ByVal argeStatus As KEY_ACTION)  

    'argtKb配列要素追加 
    On Error GoTo InitKbInput  
    ReDim Preserve argtKb(UBound(argtKb) + 1)  

    On Error Resume Next  

    'KEYBDINPUTデータ生成 
    With argtKb(UBound(argtKb))  
        .wVk = arglKey  
        .wScan = 0  
        .dwFlags = IIf(argeStatus = KEY_UP, KEYEVENTF_KEYUP, 0)
        .time = 0  
        .dwExtraInfo = 0  
    End With  

    'キーストロークのアクションの種類がKEY_BOTHの時KEYBDINPUTデータ追加 
    If argeStatus = KEY_BOTH Then

        ReDim Preserve argtKb(UBound(argtKb) + 1)  

        With argtKb(UBound(argtKb))  
            .wVk = arglKey  
            .wScan = 0  
            .dwFlags = KEYEVENTF_KEYUP  
            .time = 0  
            .dwExtraInfo = 0  
        End With  
    End If  

    Exit Sub  

InitKbInput:
    ReDim argtKb(0)  
    Resume Next  

End Sub

以上で出来上がりです。あとは、(A)仮想キーコードを配列引数として SimpleSendKeys関数に渡せばOKです。掲載した仮想キーコードですが、Shift、Ctrl、 Altキーは他のキーと組み合わせて使うことがあるのでちょっと細工してあります。 MSが定義している仮想キーコードはそれぞれ&H10、&H11、&H12ですが、押した状態と離した状態を分けるために、押した状態はコードに&HF00を加えています。

また、すべての仮想キーコードを掲載するのは大変で、現状Shift、Ctrl、Altと 'A'、'F'キーのみの定数を定義しているのみなので、 Virtual Key Codes(http://msdn.microsoft.com/en-us/library/dd375731(v=vs.85).aspx) に定数一覧があるので上記の(A)仮想キーコードの部分に付け加えていってください。

上記コードの注意点をひとつだけ。(B)キーボード／マウス入力情報用構造体 についてです。キーの送信はWin32APIのSendInputを使っていますが、この関数に渡す構造体に KEYBDINPUT、INPUTがあります。それぞれが上記のKEYBDINPUT、INPUTS構造体に対応していますが、後者は次のように定義されています。

typedef struct tagINPUT { 
  DWORD type; 
  union {MOUSEINPUT mi; 
         KEYBDINPUT ki;
         HARDWAREINPUT hi;
        };
}INPUT, *PINPUT;

SendInput関数の第三引数にINPUT構造体のサイズをバイト単位で正確に与えないといけないですが、上記のINPUTの定義からするとVBAでは

Private Type INPUTS
    type     As Long
    ki       As KEYBDINPUT
End Type

のはずです。しかし、こうするとSendInputに渡すべきINPUT構造体のサイズが正確ではありません。C言語での定義はMOUINPUTとKEYBDINPUTとHARDWAREINPUTが共用体として定義されいるのでそのサイズは一番大きなものになります。それぞれのサイズは24バイト、 16バイト、8バイトです。ですから、サイズを正確に与えるためにはMOUSEINPUTとKEYBDINPUTのサイズ差8バイトを加えてあげなければなりません。ということでreserved(7) As Byteとしてメンバに加えています。

最後に使い方の例を挙げて終わりにします。レコードソース(任意のテーブル名など)に値が設定されたフォームを用意して、コマンドボタンを配置してクリック時イベントで次のように記述してください。

'任意のフォームモジュール
Private Sub コマンド0_Click()
    Dim vlRet         As Long

    vlRet = SimpleSendKeys(VK_CONTROL_DOWN, _
                           VK_F, _
                           VK_CONTROL_UP)

    Debug.Print "送信したキーの数は" & vlRet & "個です"
End Sub

これでCtrl + 'F'がエミュレートされるので、Access2000の場合では検索と置換ダイアログボックスが表示されます。