演習36 「VBA + API」 の解説 No.4


最初に Excel VBA の VBエディタ において、次の設定を行う。
VBE - ツール - 参照設定 - (レ)Microsoft Access 9.0 Object Library


'--------------- [Module8] ---------------

'API関数の宣言

'クラスからウィンドウハンドルを取得
Declare Function FindWindow Lib "user32" _
  Alias "FindWindowA" _
    (ByVal lpClassName As String, _
     ByVal lpWindowName As String) As Long
     
'直接ウィンドウにメッセージを送る
Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" _
    (ByVal hwnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     ByVal lParam As Long) As Long
'-----------------------------------------

Private Sub apitest8()
  'Accessアプリケーションのクラス名を指定
  Dim myAccess As Access.Application
  
  'Access が事前に開かれていたかを示すフラッグ
  Dim AccessWasNotRunning As Boolean
  
  'Access が事前に起動されていたかを調べ、
  'エラーの中断を留保する
  On Error Resume Next
    
  '第1引数を指定せずに GetObject 関数を
  '呼び出すと、Access のインスタンスへの
  '参照が返される
  Set myAccess = GetObject(, "Access.Application")
  
  '事前に Access が開かれていない場合に
  'エラーが発生する(Err.Number真 <> 0)
  If Err.Number <> 0 Then
    Err.Clear  'エラーが発生した場合(Err.Number <> 0)
               'Err オブジェクトをクリアする
    AccessWasNotRunning = True
               'Access のフラッグを立てる
  End If
  
  'Access が起動しているかを調べる.  起動中の
  '場合は起動中オブジェクトテーブルに登録する
  DetectAccess
  
  '現在起動中の Access が、このコードの実行開始前
  'に起動されていなかった場合、つまりこのコードで
  'Accesse が起動された場合は Quit メソッドで終了。
  '事前に Access が起動されていた場合は終了しない。
  
  If AccessWasNotRunning = True Then
    myAccess.Application.Quit
    Set myAccess = Nothing
  Else
    MsgBox "Access が起動しています."
  End If
End Sub
'-----------------------------------------

Private Sub DetectAccess()
  'Access が起動中の場合に登録
  Dim hwnd As Long      'ウィンドウハンドル用
  Const WM_USER = 1024  '定数
    
  'Access のウィンドウハンドルを取得
  hwnd = FindWindow("OMain", vbNullString)
  
  'Access が起動していない場合は起動する
  If hwnd = 0 Then
    Set myAccess = CreateObject("Access.Application")
    
    'Accessアプリケーションを可視状態にする
    myAccess.Visible = True
    
    MsgBox "Access起動テスト" & Chr(13) & _
         "No.4 を終了します."
    Exit Sub
  Else
    'Access が起動している場合は
    '起動中テーブルに登録する
    SendMessage hwnd, WM_USER + 18, 0, 0
  End If
End Sub
'-----------------------------------------


VBAPI No.3 へ戻る.                        back top