office2010 Win32API FindWindow/FindWindowEx/PostMessage

Option Compare Database
Option Explicit

Const WM_CHAR = &H102
Const BM_CLICK = &HF5
Const SW_HIDE = 0

'FindWindow
'http://msdn.microsoft.com/ja-jp/library/cc364634.aspx
Declare PtrSafe Function FindWindow Lib "user32" _
                                Alias "FindWindowA" ( _
                                ByVal lpClassName As String, _
                                ByVal lpWindowName As String _
                                ) As LongPtr

'FindWindowEx
'http://msdn.microsoft.com/ja-jp/library/cc410853.aspx
Declare PtrSafe Function FindWindowEx Lib "user32" _
                                Alias "FindWindowExA" ( _
                                ByVal hWnd1 As LongPtr, _
                                ByVal hWnd2 As LongPtr, _
                                ByVal lpsz1 As String, _
                                ByVal lpsz2 As String _
                                ) As LongPtr

'PostMessage
'http://msdn.microsoft.com/ja-jp/library/cc410952.aspx
Declare PtrSafe Function PostMessage Lib "user32" _
                                Alias "PostMessageA" ( _
                                ByVal hwnd As LongPtr, _
                                ByVal wMsg As Long, _
                                ByVal wParam As LongPtr, _
                                ByVal lParam As LongPtr _
                                ) As Long

Declare PtrSafe Function ShowWindow Lib "user32" _
                                (ByVal hwnd As LongPtr, _
                                 ByVal nCmdShow As Long _
                                ) As Long


Sub OpenaccdrWithPassword()
    Dim pHwnd As LongPtr, cHwnd As LongPtr, btnHwnd As LongPtr
    Dim targetDBName As String
    Dim targetDBFullName As String
    Dim dialogName As String
    
    dialogName = "データベース パスワードの入力"
    
    targetDBName = "targetAppName"
    targetDBFullName = Application.CurrentProject.Path & "\target.accdr"
    
    pHwnd = FindWindow(vbNullString, targetDBName)
    If pHwnd <> 0 Then Exit Sub
    
    pHwnd = FindWindow(vbNullString, dialogName)
    If pHwnd <> 0 Then Exit Sub
    
    Shell "msaccess.exe /runtime" & targetDBFullName, vbNormalFocus
    
    Do 'カウンタつけて何かの時に対処せねばね
        pHwnd = FindWindow(vbNullString, dialogName)
        Debug.Print pHwnd
        If pHwnd <> 0 Then Exit Do
    Loop
        ShowWindow pHwnd, SW_HIDE
    Do
        cHwnd = FindWindowEx(pHwnd, 0, "RichEdit20W", vbNullString)
        Debug.Print cHwnd
        If cHwnd <> 0 Then Exit Do
    Loop
    
    Do
        btnHwnd = FindWindowEx(pHwnd, 0, "button", "OK")
        Debug.Print btnHwnd
        If btnHwnd <> 0 Then Exit Do
    Loop
        
    PostMessage cHwnd, WM_CHAR, Asc("p"), 0
    PostMessage cHwnd, WM_CHAR, Asc("@"), 0
    PostMessage cHwnd, WM_CHAR, Asc("s"), 0
    PostMessage cHwnd, WM_CHAR, Asc("S"), 0
    
    PostMessage btnHwnd, BM_CLICK, 0, 0
    
    Application.Quit
End Sub