アクティブウィンドウにキーストロークを送る
 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
アクティブウィンドウにキーストロークを送る（SendKeysステートメントもどき関数）　(129)
          　　　　　　　　　　　       Option Explicit　　 'SampleNo=129　WindowsXP VB6.0(SP5) 2002.04.08
　　　　　　　　　　'動作確認　Win95(VB5.0) Win98(VB5.0) WinXP(VB6.0)
'==================================================================
'キーストロークをシミュレートする(P1065)
Private Declare Sub keybd_event Lib "user32.dll" _
　 (ByVal bVk As Byte, ByVal bScan As Byte, _
　　ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2　　　　 'キーアップ
Private Const KEYEVENTF_EXTENDEDKEY = &H1　 'スキャンコードは拡張コード
'仮想キーコード・ASCII値・スキャンコード間でコードを変換する(P1067)
Private Declare Function MapVirtualKey Lib "user32" _
　　Alias "MapVirtualKeyA" (ByVal wCode As Long, _
　　ByVal wMapType As Long) As Long
'==================================================================
'システムを立ち上げてからの経過時間を高精度に取得する(P1002)
Private Declare Function timeGetTime Lib "winmm.dll" () As Long


Private Sub Command1_Click()
'別途メモ帳を起動し、何か記入しておいて下さい。
　　Dim i As Integer
　　AppActivate "無題 - メモ帳"　'注意！ Win95 はメモがカタカナ半角
　　StopTime (100)　　　　　　　　　　　　　　　　'アクティブになるまで待つ
　　'For i = 1 To 10　'このような連続使用も問題なし
　　Call sSetSendKeys(vbKeyMenu, vbKeyE, vbKeyA)　'すべて選択
　　Call sSetSendKeys(vbKeyControl, vbKeyC)　　　 'コピー
　　Call sSetSendKeys(vbKeyRight)　　　　　　　　 '→　右に移動（選択解除）
　　'Next i
End Sub


Private Sub Command2_Click()
'Command1_Click後に実施して下さい。
　　Dim i As Integer
　　AppActivate "無題 - メモ帳"
　　StopTime (100)　　　　　　　　　　　　　 'アクティブになるまで待つ
　　'For i = 1 To 10
　　Call sSetSendKeys(vbKeyRight)　　　　　　'→　右に移動（選択解除）
　　Call sSetSendKeys(vbKeyControl, vbKeyV)　'貼り付け
　　'Next i
End Sub


Private Sub Command3_Click()
'データ（文字列）をアクティブウィンドウに送ります。
　　Dim i As Integer
　　AppActivate "無題 - メモ帳"
　　StopTime (100)　　　　　　　　　　　　　'アクティブになるまで待つ
　　'For i = 1 To 10
　　Call sSetSendTxts(Text1.Text & vbCrLf)
　　'Next i
End Sub


Private Sub sSetSendKeys(bVk1 As Long, _
　　　　　　　　Optional bVk2 As Long = 0, Optional bVk3 As Long = 0)
'SendKeys と同様にアクティブウィンドウにキーストロークを送る
'以下のパターンは必要により追加して下さい。
　　If bVk2 = 0& And bVk3 = 0& Then
　　'キーを１個だけ送る
　　　　Call keybd_event(CByte(bVk1), MapVirtualKey(CByte(bVk1), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or 0, 0)
　　　　Call keybd_event(CByte(bVk1), MapVirtualKey(CByte(bVk1), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
　　ElseIf bVk3 = 0& Then
　　'キーの複合操作　[Alt] + [E] 等
　　　　Call keybd_event(CByte(bVk1), MapVirtualKey(CByte(bVk1), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or 0, 0)
　　　　Call keybd_event(CByte(bVk2), MapVirtualKey(CByte(bVk2), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or 0, 0)
　　　　Call keybd_event(CByte(bVk2), MapVirtualKey(CByte(bVk2), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
　　　　Call keybd_event(CByte(bVk1), MapVirtualKey(CByte(bVk1), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
　　ElseIf (bVk1 <> 0&) And (bVk2 <> 0&) And (bVk3 <> 0&) Then
　　'SendKeys "%(EA)" と同様の操作
　　　　Call keybd_event(CByte(bVk1), MapVirtualKey(CByte(bVk1), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or 0, 0)
　　　　Call keybd_event(CByte(bVk2), MapVirtualKey(CByte(bVk2), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or 0, 0)
　　　　Call keybd_event(CByte(bVk2), MapVirtualKey(CByte(bVk2), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
　　　　Call keybd_event(CByte(bVk3), MapVirtualKey(CByte(bVk3), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or 0, 0)
　　　　Call keybd_event(CByte(bVk3), MapVirtualKey(CByte(bVk3), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
　　　　Call keybd_event(CByte(bVk1), MapVirtualKey(CByte(bVk1), 0), _
　　　　　　　　　　　　KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
　　End If
　　StopTime (50)　　 '連続処理した場合を考慮
End Sub


Private Sub sSetSendTxts(MyString As String)
'SendKeys と同様にデータ（文字列）をアクティブウィンドウに送ります。
　　'クリップボードを初期化
　　Clipboard.Clear
　　StopTime (10)
　　'選択した範囲のテキストをコピー
　　Clipboard.SetText MyString
　　StopTime (10)
　　Call sSetSendKeys(vbKeyControl, vbKeyV) '貼り付け
　　StopTime (10)
End Sub


Private Sub StopTime(st As Long)
'指定の時間待つ（1/1000 秒単位で指定)
　　Dim lngSt As Long
　　lngSt = timeGetTime
　　Do While timeGetTime - lngSt < st
　　　　DoEvents
　　Loop
End Sub
フォームにコマンドボタン３個とテキストボックス１個を貼り付けておいて下さい。
メモ帳をアクティブにし、すべて選択し、コピーします。
SendKeysステートメントと同様の操作をkeybd_event()API関数を使って操作を関数化する
ことで操作を簡略化しております。使い方等で関数に機能を追加して見て下さい。
又、WindowsXP・Windows2000 等ではShift キーがうまく動作しない問題もスキャンコード間で
コードを変換する　事で対応しております。
尚、keybd_event()API はWin2000 以降はSendInput を使ってくださいとの事です。
SendKeysステートメントでは色々問題があったがkeybd_event()API関数を使用する事で軽
減されVBから他のアプリが操作できるかと思います。



2002/05/14