Win32API | Excel作業をVBAで効率化 https://vbabeginner.net いつものExcel作業はVBAを使えば数秒で終わるかもしれませんよ Sat, 09 Nov 2024 05:40:35 +0000 ja hourly 1 https://wordpress.org/?v=6.6.2 https://vbabeginner.net/wp-content/uploads/2019/02/favicon-150x150.png Win32API | Excel作業をVBAで効率化 https://vbabeginner.net 32 32 VBAでファイルをゴミ箱に移動させる(SHFileOperation) https://vbabeginner.net/move-files-trash/ Sun, 20 Feb 2022 17:41:37 +0000 https://vbabeginner.net/?p=6478 VBAでの一般的な削除処理はゴミ箱に移動せず完全削除される

VBAにはファイル削除の方法としていくつかあります。

  1. VBA標準のKillステートメント(一番簡単
  2. FileSystemObjectのDeleteFileメソッド
  3. FileオブジェクトのDeleteメソッド
  4. Shell32ライブラリのShellオブジェクトのMoveHereメソッド
  5. Win32APIのDeleteFile関数

これらの方法で実行すると、いずれの場合もファイルが完全に削除されます。ゴミ箱には行きませんマウス操作でファイルを削除した場合の「完全に削除しますか」→「はい」の状態です。

VBAで処理をする場合、いらないファイルを消すというのは本当に要らないから消すことが一般的なため、ゴミ箱に一時的に残しておく必要はまずないですが、人が操作したときと同じようにゴミ箱に残しておきたい場合には上記の方法では困ります。

そこで、以下ではマウス操作の削除のようにゴミ箱に移動させる方法を紹介します。

VBAでゴミ箱に移動させる方法

VBAでゴミ箱に移動させるにはWin32APIのSHFileOperation関数を利用します。Win32APIについては「VBAでWin32APIを使う方法と定義一式」をご参照ください。

後述のサンプルコードに全部書いていますのでダウンロードは不要ですが、当ページで利用しているWin32APIの定数、構造体、関数の定義が書かれているWin32API_PrtSafe.TXTもダウンロードできるようにしています。

Declare PtrSafe Function SHFileOperation Lib “shell32.dll” Alias “SHFileOperationA” (lpFileOp As SHFILEOPSTRUCT) As Long

引数にはSHFILEOPSTRUCT構造体を指定します。

Type SHFILEOPSTRUCT
        hwnd As LongPtr
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAnyOperationsAborted As Long
        hNameMappings As LongPtr
        lpszProgressTitle As String '  only used if FOF_SIMPLEPROGRESS
End Type

SHFileOperation関数は、Windowsでのマウスやキーボードを使ったファイル操作を行った場合と同様の動作を行うことが出来ます。

上で挙げたファイル削除方法は、ファイルが完全に削除されますが、SHFileOperation関数ではゴミ箱に移動させる削除が可能になります。

ただし以下の制約があります。

ネットワークドライブのファイル削除はゴミ箱に行かず完全削除される

ここではSHFileOperation関数でのごみ箱への移動方法を主に書いていますが、コピーや移動などの操作の場合も、Windowsの制約がSHFileOperation関数の挙動に引き継がれます

例えば、Windowsでのファイルの削除は、Cドライブなどのローカルディスクにある場合とネットワークドライブにある場合とでは挙動が異なり、ローカルディスクの場合はゴミ箱への移動が可能ですが、ネットワークドライブの場合はゴミ箱を経由できずに完全削除しかできません。これはSHFileOperation関数を使った場合も同様です。

エクスプローラーを使って、ネットワークドライブ上のファイルを削除しようとすると、右クリックで削除した場合は「完全に削除しますか?」と聞かれ、「はい」を押すとゴミ箱に行かず削除されます。また、エクスプローラの削除メニューの「ゴミ箱に移動」はグレーアウトしており利用できません。これが、ローカルディスクであればゴミ箱への移動が可能になります。

一応、ネットワーク上のファイルをゴミ箱での削除を行うようにすることは可能ですが、ネットーワークドライブ側の共有設定だったり特殊なアプリを使う必要があったりと、設定のここをいじればOK、みたいな話ではありません。

そのため、以下のコードではローカルディスク上のファイルを削除した場合にゴミ箱に行きますが、ネットワークドライブ上のファイルを削除した場合はゴミ箱に行かず完全削除になります。

コード

SHFileOperation関数を利用するにはSHFileOperation関数自体のDeclare宣言と、SHFILEOPSTRUCT構造体の定義が必要です。

サンプルコードのSHFileOperation関数自体のDeclare宣言と、SHFILEOPSTRUCT構造体の定義はWin32API_PrtSafe.TXTの内容をそのまま引用しています。

SHFILEOPSTRUCT構造体には8つの変数がありますが、ゴミ箱への削除の場合はコードの通り4つを設定すればOKです。

定数もWin32API_PrtSafe.TXTの内容をそのまま引用していますが、使わない定数は無くても構いません。具体的には、FO_DELETE、FOF_ALLOWUNDO、FOF_NOCONFIRMATIONの3つのConstが書いてあればOKです。

利用している定数の説明ですが、定数FO_DELETEはファイルやフォルダの削除を行う際に指定します。注意点としてPで始まるPO_DELETEがありますが、こちらを使うとエラーになります。実行してもファイルが削除されずエラー87が発生する場合は、FO_DELETEではなく間違ってPO_DELETEを指定していないか確認してください。

FOF_ALLOWUNDOは取消情報の保持を許可します。ファイル削除の場合は、ゴミ箱への移動を行い、ゴミ箱から元に戻すことを意味します。

FOF_NOCONFIRMATIONはダイアログのボタンを「はい」を押した状態として扱います。ファイル削除の場合にFOF_NOCONFIRMATIONが無く、FOF_ALLOWUNDOしか指定されていない場合は、ファイルを削除することを確認するダイアログが表示されます。

Const FO_MOVE = &H1
Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_RENAME = &H4
Const FOF_MULTIDESTFILES = &H1
Const FOF_CONFIRMMOUSE = &H2
Const FOF_SILENT = &H4                      '  don't create progress/report
Const FOF_RENAMEONCOLLISION = &H8
Const FOF_NOCONFIRMATION = &H10             '  Don't prompt the user.
Const FOF_WANTMAPPINGHANDLE = &H20          '  Fill in SHFILEOPSTRUCT.hNameMappings
                                      '  Must be freed using SHFreeNameMappings
Const FOF_ALLOWUNDO = &H40
Const FOF_FILESONLY = &H80                  '  on *.*, do only files
Const FOF_SIMPLEPROGRESS = &H100            '  means don't show names of files
Const FOF_NOCONFIRMMKDIR = &H200            '  don't confirm making any needed dirs

Const PO_DELETE = &H13           '  printer is being deleted
Const PO_RENAME = &H14           '  printer is being renamed
Const PO_PORTCHANGE = &H20       '  port this printer connected to is being changed
                                '  if this id is set, the strings received by
                                '  the copyhook are a doubly-null terminated
                                '  list of strings.  The first is the printer
                                '  name and the second is the printer port.
Const PO_REN_PORT = &H34         '  PO_RENAME and PO_PORTCHANGE at same time.

Type SHFILEOPSTRUCT
        hwnd As LongPtr
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAnyOperationsAborted As Long
        hNameMappings As LongPtr
        lpszProgressTitle As String '  only used if FOF_SIMPLEPROGRESS
End Type

Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Sub SHFileOperationTest()
    Dim sPath   As String               '// ファイルパス
    Dim t       As SHFILEOPSTRUCT       '// ファイル操作構造体
    Dim ret     As Long                 '// 処理結果
    
    '// 削除対象ファイルパスを設定
    sPath = "C:\abc\abc.txt"
    
    '// 構造体設定
    t.hwnd = Application.hwnd   '// ウインドウハンドル
    t.wFunc = FO_DELETE         '// 処理:削除
    t.pFrom = sPath             '// 処理対象:ファイルパス
    t.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION  '// ゴミ箱
    
    '// ファイルをゴミ箱へ移動
    ret = SHFileOperation(t)
    
    '// 削除失敗時
    If ret <> 0 Then
        Debug.Print ret
    End If
End Sub

]]>
VBAでWindows起動後の経過時間を取得する(GetTickCount) https://vbabeginner.net/gettickcount/ Thu, 23 Sep 2021 14:28:17 +0000 https://vbabeginner.net/?p=6258 Windows起動後の経過時間の取得方法

VBAには経過時間をミリ秒で取得できるTimer関数がありますが、0時になると0ミリ秒にリセットされるため、日付を超える場合は利用できません。

Windowsを起動してからどれぐらいの時間が経っているかを調べるには、Win32API(Windows API)のGetTickCount関数やGetTickCount64関数を利用します。

GetTickCount64関数を使えるのであればそちらをお勧めします。

構文

64bit版です。

Declare PtrSafe Function GetTickCount Lib “kernel32” () As Long
Declare PtrSafe Function GetTickCount64 Lib “kernel32” () As LongLong

GetTickCount戻り値 Windowsが起動してからどれだけ経過したかをミリ秒で返します。約49.7日まで扱えます。
GetTickCount64戻り値 Windowsが起動してからどれだけ経過したかをミリ秒で返します。通常は約2.9億年まで扱えます。

使う方だけを標準モジュールなどの先頭あたりに記述します。

戻り値の範囲

GetTickCount関数は宣言では戻り値がLong型になっていますが、実際の定義では符号なしの32ビットの整数値になります。同様に、GetTickCount64関数の戻り値はLongLong型ですが実際の戻り値は符号なしの64ビットの整数値です。

そのため、扱える値の範囲は以下のようになります。

関数 最小値 最大値 日数・年数換算
GetTickCount 0 4,294,967,296 約49.7日(4,294,967,296÷(1000ms×60s×60m×24h)=49.7102696296日)
GetTickCount64 0 18,446,744,073,709,551,616 約5.8億年(18,446,744,073,709,551,616÷(1000ms×60s×60m×24h×365.2425)=584,554,049.254)

表のとおり、GetTickCount関数とGetTickCount64関数の戻り値は符号なし(マイナス値なし)ですが、VBAのLong型が扱える値の範囲は符号つきの −2,147,483,648 から 2,147,483,647 で、LongLong型は -9,223,372,036,854,775,808 から 9,223,372,036,854,775,807 のため、GetTickCount関数またはGetTickCount64関数の戻り値のほぼ半分の値までしか扱えません。

では、GetTickCount関数で半分(約24.8日)を超えた値が帰ってきた場合どうなるのか、という話になりますが、戻り値をLong型の変数で受け取った場合は2,147,483,647を超えてしまうためオーバーフローとなり異常が発生します。

そこで対応方法としては、戻り値はLong型ではなく64ビットのLongLong型で受け取ればオーバーフローにならずに済みます。LongLong型がないバージョンのExcelであればDouble型でも代用できます。ただ、そういうことを考えるのが面倒であればGetTickCount64関数を使うことをお勧めします。

なお、GetTickCount64関数では最大値が約5.8億年で、「PC起動して5.8億年つけっぱなしにしたらオーバーフローで落っこちました」なんてことはありえないため、考慮不要でLongLong型で受け取ってよいと思います。ただし、約5.8億年は符号なしの場合のため、符号ありのLongLong型では半分の約2.9億年が限度になります。

サンプルコード

GetTickCount関数とGetTickCount64関数のサンプルです。比較としてTimer関数も出力しています。

モジュールの先頭あたりにDeclare~の構文を記述します。

先に書いた説明の通り、GetTickCount関数の戻り値を受け取る変数はLong型ではなくLongLong型で設定しています。LongLong型がない場合はDouble型でも構いません。

Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Declare PtrSafe Function GetTickCount64 Lib "kernel32" () As LongLong

Sub GetTickCountTest()
    Dim t   As LongLong '// DoubleでもOK
    Dim t64 As LongLong
    Dim tm  As LongLong
    
    t = GetTickCount
    t64 = GetTickCount64
    tm = Timer
    
    '// ミリ秒
    Debug.Print "GetTickCount   ミリ秒:" & t
    Debug.Print "GetTickCount64 ミリ秒:" & t64
    Debug.Print "Timer          ミリ秒:" & tm
    '// 秒
    Debug.Print "GetTickCount   秒:" & t / 1000
    Debug.Print "GetTickCount64 秒:" & t64 / 1000
    Debug.Print "Timer          秒:" & tm / 1000
    '// 分
    Debug.Print "GetTickCount   分:" & t / 1000 / 60
    Debug.Print "GetTickCount64 分:" & t64 / 1000 / 60
    Debug.Print "Timer          分:" & tm / 1000 / 60
    '// 時
    Debug.Print "GetTickCount   時:" & t / 1000 / 60 / 60
    Debug.Print "GetTickCount64 時:" & t64 / 1000 / 60 / 60
    Debug.Print "Timer          時:" & tm / 1000 / 60 / 60
    '// 日
    Debug.Print "GetTickCount   日:" & t / 1000 / 60 / 60 / 24
    Debug.Print "GetTickCount64 日:" & t64 / 1000 / 60 / 60 / 24
    Debug.Print "Timer          日:" & tm / 1000 / 60 / 60 / 24
    '// 年
    Debug.Print "GetTickCount   年:" & t / 1000 / 60 / 60 / 24 / 365.2425
    Debug.Print "GetTickCount64 年:" & t64 / 1000 / 60 / 60 / 24 / 365.2425
    Debug.Print "Timer          年:" & tm / 1000 / 60 / 60 / 24 / 365.2425
End Sub

実行結果
GetTickCount ミリ秒:434636359
GetTickCount64 ミリ秒:434636359
Timer ミリ秒:81633
GetTickCount 秒:434636.359
GetTickCount64 秒:434636.359
Timer 秒:81.633
GetTickCount 分:7243.93931666667
GetTickCount64 分:7243.93931666667
Timer 分:1.36055
GetTickCount 時:120.732321944444
GetTickCount64 時:120.732321944444
Timer 時:2.26758333333333E-02
GetTickCount 日:5.03051341435185
GetTickCount64 日:5.03051341435185
Timer 日:9.44826388888889E-04
GetTickCount 年:1.37730779259036E-02
GetTickCount64 年:1.37730779259036E-02
Timer 年:2.58684679052654E-06

]]>
VBAの処理を一時停止する(Sleep、Wait) https://vbabeginner.net/sleep-wait/ Mon, 20 Sep 2021 15:47:44 +0000 https://vbabeginner.net/?p=6247 一定時間だけ処理を止めるには

VBAの処理中に一定時間だけ処理を止めたいことがあります。方法としてWin32APIのSleep関数とApplication.Waitメソッドが挙げられます。

どちらを使ってもいいのですが、引数に一時停止時間をミリ秒で指定するだけのSleep関数の方が直感的で使いやすいです。Application.Waitメソッドは「いつまで止めるか(いつから再開するか)」という時刻を指定する方法になります。

以下ではSleep関数とWaitメソッドの使い方を紹介します。

なお、一時停止の途中でSleepをやめることができるWin32APIのSleepEx関数もありますが、そこまで厳密な一時停止処理はVBAではまず用途が無いと思いますのでここでは省略します。

Sleep関数の構文

64bit版です。モジュールに以下の構文をそのまま書いておくと利用できます。一般的には標準モジュールの先頭に書くことが多いです。

Declare PtrSafe Sub Sleep Lib “kernel32” Alias “Sleep” (ByVal dwMilliseconds As Long)

dwMilliseconds:ミリ秒で指定します。1秒=1000ミリ秒のため、1秒止めたい場合は1000を指定します。マイナス値を指定するとVBAから応答が返ってこなくなり、Excelをタスクマネージャなどで強制終了することになります。

戻り値はありません。

Sleep関数のサンプルコード

Sleep関数の使い方は単純です。何ミリ秒止めるかを引数で指定するだけです。Declareの行を忘れずに書いてください。

Declare PtrSafe Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Sub SleepTest()
    Dim i                   '// ループカウンタ

    For i = 0 To 5
        '// 1秒停止
        Call Sleep(1000)
        Debug.Print Now
    Next
End Sub

実行結果
2021/09/21 0:51:42
2021/09/21 0:51:43
2021/09/21 0:51:44
2021/09/21 0:51:45
2021/09/21 0:51:46
2021/09/21 0:51:47

Application.Waitメソッドの構文

Function Wait(Time) As Boolean

Time いつまで停止するかをDate型に変換できる時分秒の時刻で指定します。”00:00:00″形式で指定するか、TimeValue関数で”00:00:00″形式で指定するか、TimeSerial関数で時分秒を指定すると、正しい引数として認識されます。
戻り値 指定した時刻に達するとTrueを返します。

Application.Waitメソッドのサンプルコード

以下のコードはApplication.Waitメソッドの引数のパターンを変えてます。文字列で”00:00:00″形式で時刻を指定する方法と、現在日時にTimeValue関数で1秒を”00:00:00″形式で加算する方法です。

Sub WaitTest()
    Dim i                   '// ループカウンタ
    
    '// 指定時刻まで停止
    Call Application.Wait("00:53:01")
    Debug.Print Now
    
    For i = 0 To 5
        '// 1秒停止
        Call Application.Wait(Now + TimeValue("00:00:01"))
        Debug.Print Now
    Next
End Sub

実行結果
2021/09/21 0:53:01
2021/09/21 0:53:02
2021/09/21 0:53:03
2021/09/21 0:53:04
2021/09/21 0:53:05
2021/09/21 0:53:06
2021/09/21 0:53:07

一時停止の用途

処理を一時停止する用途は、大きく分けて2つあります。

1つは、VBAから他のプログラムの操作を行い、その処理の待ち時間として利用する場合です。

例えばVBAからバッチファイルを実行し、その処理が終わるまでの時間が10秒だとしたら余裕を見て待ち時間としてSleep関数で20秒間停止したり、インターネットからURLを変えながら情報を取得する際に、一定時間置いてから再度アクセスしてサーバーの負荷を上げないようにするための待ち時間などです。

もう1つは、恒常ループや無限ループと言われるような同じ処理を繰り返し行う場合に、CPUを休ませる目的で使います。ただ、最近のPCはコア数やスレッド数が複数あるのが一般的ですので、「VBAがCPUを独占しているため他のプログラムが動かない」、なんて話はほぼ無くなってはいます。

Sleep関数とWaitメソッドのどちらを使えばよいか

Sleep関数とWaitメソッドは用途が異なります。

どちらも同じような使い方は出来ますが、処理中に一時的にVBAの処理を止めたい場合はSleep関数を利用し、処理を再開する時刻を指定する場合はApplication.Waitメソッドを利用した方が、あとから見たときに何をしたいコードなのか分かりやすくなります。

]]>
どのキーが押されたのかをVBAで判定する(GetAsyncKeyState) https://vbabeginner.net/getasynckeystate/ Sun, 12 Sep 2021 07:37:22 +0000 https://vbabeginner.net/?p=6229 どのキーが押されたのかはGetAsyncKeyState関数で確認

キーボードのどのキーが押されたのかをVBAで取得するには、Win32APIのGetAsyncKeyState関数を使います。

キーの押し方には、文字入力のために使う単独キー入力の場合と、ショートカットとして複数のキーが同時に押される場合がありますが、いずれの場合もGetAsyncKeyState関数で取得できます。

なお、キーを「押す場合にはVBAのSendKeysステートメントを使います。

SendKeysの詳細については「VBAで疑似的にキーボード入力を行う(SendKeys)」をご参照ください。

GetAsyncKeyState関数は無限ループとSleep関数と一緒に使う

GetAsyncKeyState関数を単独で使うことはまずありません。ほとんどの場合は無限ループとセットになっています

なぜかと言うと、キーが押されたことを知りたい、ということは、何かしらユーザーのキーボード操作を待っている状態であることが前提になります。ユーザーの操作を待っている、ということは、操作がされるまで待ち続けることになりますが、その「待ち続ける」処理は無限ループで実現するのが一般的です。

例えて言えば、ゲームのキャラクターをコントローラーの十字キーの代わりに矢印の↑→←↓キーで操作している場合などです。ゲームが終わるまでキー操作が行われることを常に監視しなければならないため、結果としてゲームオーバーなどのなんらかの停止条件に達するまで、無限ループをしながらキー操作の判定を行うことになります。

ただし、無限ループをずっと続けることはCPUの占有に繋がるため、Win32APIのSleep関数を使ってCPUを一定時間休止させることも必要です。そのCPUの休止を判定するためにタイマーを使ってどれだけ時間が経過したかを判定することも必要になります。

これらのことから、必然的にGetAsyncKeyState関数を使う場合は、無限ループとSleep関数と時間の経過判定を行うことになります。

もちろんそうでない場合もありますがかなり特殊なケースです。ここではそのような特殊なケースや無理やりのGetAsyncKeyState関数を動かすだけのサンプルコードではなく、一般的な使い方でのサンプルコードを紹介します。

構文

64bit版です。モジュールに以下の構文をそのまま書いておくと利用できます。一般的には標準モジュールの先頭に書くことが多いです。

Declare PtrSafe Function GetAsyncKeyState Lib “user32” (ByVal vKey As Long) As Integer

vKey 押したことを確認したいキーを指定します。KeyCodeConstants定数を指定します。定数の数値を直接しても構いません。

KeyCodeConstants定数の詳細は「VBAのキーコード一覧」をご参照ください。

戻り値(Integer) 4種類の数値を返します。詳細は後述します。

内容
0 キーが押されていない、かつ、前回のGetAsyncKeyState関数呼び出し後にキーが押されていない
1 キーが押されていない、かつ、前回のGetAsyncKeyState関数呼び出し後にキーが押されている(別アプリがGetAsyncKeyState関数を呼び出した可能性あり)
-32768 キーが押されている、かつ、前回のGetAsyncKeyState関数呼び出し後にキーが押されていない
-32767 キーが押されている、かつ、前回のGetAsyncKeyState関数呼び出し後にキーが押されている(別アプリがGetAsyncKeyState関数を呼び出した可能性あり)

GetAsyncKeyState関数の戻り値の詳しい話

GetAsyncKeyState関数の戻り値について上では概要だけ書いてますが、少し細かく書きます。

GetAsyncKeyState関数の戻り値はC言語のshort型という2バイト(16bit)のサイズになります。short型は範囲として-32768から32767の値が使えます。VBAでは同じ2バイトのInteger型が使われています。16ビットということは2の16乗の範囲でデータを持つことが出来ます。0から65535の範囲ですが、Integer型はマイナス値も含めるため-32768から32767の範囲になります。

そして、ここが一番特殊な話ですが、GetAsyncKeyState関数の戻り値は、Integer型を2進数として扱った場合の一番左(最上位)の値が1であればキーが押されている、0であれば押されていない、と判定し、一番右(最下位)の値が1であれば前回GetAsyncKeyState関数を呼び出したあとにキーが押されている、0であれば押されていない、と判定します。

整理すると以下のようになります。

2進数 10進数 16進数 キーが押されているか? 前回のGetAsyncKeyState関数呼び出し後に押された?
0000 0000 0000 0000 0 &H0 押されていない 押されていない
0000 0000 0000 0001 1 &H1 押されていない 押された(別アプリが呼び出した可能性あり)
1000 0000 0000 0000 -32768 &H8001 押されている 押されていない
1000 0000 0000 0001 -32767 &H8000 押されている 押された(別アプリが呼び出した可能性あり)

戻り値の-32768と-32767がなんでマイナスの値なのかですが、最上位ビットに1が設定されていることが原因です。通常使う10進数のマイナスを表す場合は-記号を使うルールですが、2進数の場合はマイナス記号(負号)を使わずに一番左側にある最上位ビットが1の場合はマイナスとして扱うルールになっています。そのため、マイナス値の戻り値になります。詳しいことを知りたい場合は「2の補数」を調べてみてください。

このように2進数の各ビット値の1と0でなんらかの状況のONとOFFを表現するものがWin32APIではよくあります。

最下位ビットの判定は注意が必要です。「最下位ビットが1だから、キーが押されたことを初めて検知した」と判断したくなりますが、それは誤検知の恐れがあります。他のアプリケーションでGetAsyncKeyState関数を利用している場合はそれがOS全体に引き継がれるため、その場合には正しく判定できません。

そのため、Microsoftのヘルプページでは「最下位ビットの動作は信頼しないでください」という趣旨のことが書いてあります。どのキーが押されたかではなく、キーが押されたかどうかを優先して判定したいのであればGetAsyncKeyState関数を使うのではなく、フォームでのKeyDownイベントやKeyPressイベントを使うことをお勧めします。

サンプルコード

以下のコードはGetAsyncKeyState関数を使う際の無限ループの仕組みとSleep関数を使ったCPU占有の解放も考慮しています。

Win32APIを3つ使っています。GetAsyncKeyState関数、Sleep関数、GetTickCount関数です。Sleep関数は引数の値をミリ秒スリープします。GetTickCount関数はPCが起動してからの経過時間をミリ秒単位で返します。

Sleep関数についての詳細は「VBAの処理を一時停止する(Sleep、Wait)」をご参照ください。

VBAの関数が2つありますが、GetAsyncKeyStateTest関数が実行する側のメイン関数で、ChkKeyPush関数がGetAsyncKeyState関数を使って指定したキーが押されたかどうかを判定します。

1つ目のGetAsyncKeyStateTest関数はAキーとShiftキーが押されたときにイミディエイトウィンドウに”A”、”Shift”を出力し、Qキーが押されたときに”Quit”と出力して無限ループを終了して関数を終了します。無限ループ+スリープ+DoEventsでのWindows制御可を実装しているため一般的な常時稼働中でのキーが押されたことの判定処理として利用できます。

2つ目のChkKeyPush関数がGetAsyncKeyState関数を実際に利用している箇所です。&H8000で最上位ビットが1かどうかの判定も入れてます。最上位ビットを判定しない場合、レアケースではありますが他アプリケーションで指定キーと同じキーをGetAsyncKeyState関数で判定している場合に、戻り値の最下位ビットに1が設定され、「キーが初めて押された=True」と誤検知する恐れがあるためそれを防いでいます。

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long

Sub GetAsyncKeyStateTest()
    Dim bEndFlg     As Boolean      '// ループ終了フラグ(True:ループ継続、False:ループ終了)
    Dim lStartTimer As Long         '// 基点時刻
    Dim sMsg        As String       '// 出力MSG
    
    '// ループ継続
    bEndFlg = True
    
    '// 基点時刻を取得
    lStartTimer = GetTickCount
    
    Do
        '// ループ終了フラグが「ループ終了」の場合
        If bEndFlg = False Then
            '// ループを抜ける
            Exit Do
        End If
        
        Dim bKeyA       As Boolean
        Dim bKeyShift   As Boolean
        
        sMsg = ""
        
        '// Qが押された場合
        If (ChkKeyPush(vbKeyQ) = True) Then
            '// ループ終了フラグを「ループ終了」に更新
            bEndFlg = False
            Debug.Print "Quit"
        End If
        
        '// Aが押された場合
        If (ChkKeyPush(vbKeyA) = True) Then
            bKeyA = True
        Else
            bKeyA = False
        End If
        
        '// Shiftが押された場合
        If (ChkKeyPush(vbKeyShift) = True) Then
            bKeyShift = True
        Else
            bKeyShift = False
        End If
        
        '// Aが押されていた場合
        If bKeyA = True Then
            sMsg = "A "
        End If
        '// Shiftが押されていた場合
        If bKeyShift = True Then
            sMsg = sMsg & "Shift "
        End If
        
        If sMsg <> "" Then
            Debug.Print sMsg
        End If
        
        '// Windowsに制御を渡す
        DoEvents
        
        '// 0.1秒経過するまでスリープ
        Do While GetTickCount - lStartTimer < 100
            '// CPUを休ませる(ループ処理にCPUが占有されないようにして負荷を下げる)
            Call Sleep(1)
        Loop
        
        '// 基点時刻を再取得
        lStartTimer = GetTickCount
    Loop
End Sub

Function ChkKeyPush(a_iKeyCode)
    '// 指定キーが押された
    If (GetAsyncKeyState(a_iKeyCode) And &H8000) Then
        ChkKeyPush = True
    '// 指定キーが押されていない
    Else
        ChkKeyPush = False
    End If
End Function

実行結果
AキーとShiftキーをそれぞれ押して、Qキーで終了した場合の例です。キーを押し続けていると連続して出力されます。

A
A
Shift
Shift
Shift
A Shift
A Shift
A Shift
A Shift
A Shift
A Shift
Shift
Quit

]]>