アプリケーションの二重起動を確認

こんにちは、パパりおです。

今回はAccessでプログラムを作成している時によく使う「二重起動のチェック」を実装するコードをご紹介します。

なお、筆者の環境は以下の通りです。

さっそくコードをご紹介

Option Compare Database
Option Explicit

Public Function IsRunning() As Boolean
'/*********************************************************
' 処理名：初期化処理
' 引　数：fm(Object)  ：対象のフォームオブジェクト
'       fmType(Long)：フォーム種類（eFormTypeで宣言）
'       fmTitle(Optional / String)：フォームタイトル名
' 戻り値：True：正常終了 / False：エラー終了
' 備　考：
'*********************************************************/
'On Error Resume Next

'/* 戻り値の初期設定 */
IsRunning = False

'/* アプリケーションタイトルを取得 */
Dim appTitle As String
appTitle = CurrentDb.Properties("AppTitle")

'/* ウィンドウハンドルを取得 */
Dim hwnd As Long
hwnd = GetWindow(Application.hWndAccessApp, GW.HWNDFIRST)

Do Until hwnd = 0
  '/* ウィンドウタイトルを取得 */
  Dim windowTitle As String
  Dim ret As Variant
  windowTitle = String(256, Chr(0))
  ret = GetWindowText(hwnd, windowTitle, Len(windowTitle))
  windowTitle = removeNull(windowTitle)
  
  '/* クラス名を取得 */
  Dim className As String
  className = String(256, Chr(0))
  ret = GetClassName(hwnd, className, Len(className))
  className = removeNull(className)
  
  '/* アプリケーションタイトルと同ウィンドウの存在チェック */
  If windowTitle = appTitle And _
     className = "OMain" And _
     hwnd <> Application.hWndAccessApp Then
    IsRunning = True
    Exit Function
  End If
  
  Debug.Print "アプリケーションタイトル=" & appTitle & ", ウィンドウタイトル＝" & windowTitle & ", クラス名＝" & className & ", hwnd=" & hwnd & ", hWndAccessApp=" & Application.hWndAccessApp
  hwnd = GetWindow(hwnd, GW.HWNDNEXT)
Loop

End Function