office2010 Win32API SendMessage

Option Compare Database
Option Explicit

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

Declare PtrSafe Function FindWindow Lib "user32" _
                                Alias "FindWindowA" ( _
                                ByVal lpClassName As String, _
                                ByVal lpWindowName As String _
                                ) As LongPtr

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

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

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

Sub OpenaccdrWithPassword()
    Dim pHwnd As LongPtr, cHwnd As LongPtr, btnHwnd As LongPtr
    Dim taskID As Double
    Dim targetDBName As String
    Dim targetDBFullName As String
    Dim dialogName As String
    Dim strDBPassword As String
    
    
    strDBPassword = "p@ssw0rd"
    
    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
    
    taskID = Shell("msaccess.exe /runtime " & _
                    targetDBFullName, vbNormalFocus)
    If taskID = 0 Then Exit Sub
    
    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
    
    SendMessage cHwnd, WM_SETTEXT, 0, ByVal strDBPassword
    
    PostMessage btnHwnd, BM_CLICK, 0, 0
    
    Application.Quit
End Sub