office2010 Win32API GetDlgItem/GetLastActivePopup

Option Compare Database
Option Explicit

Private Const GW_HWNDNEXT = &H2
Private Const WM_SETTEXT = &HC
Private Const BM_CLICK = &HF5
Private Const IDOK = &H1
Private Const IDCANCEL = &H2
Private Const IDHELP = &H9
Private Const IDC_EDIT = &H8A5 '決め打ち

'http://msdn.microsoft.com/ja-jp/library/cc364779.aspx
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" ( _
                                ByVal hwnd As LongPtr, _
                                lpdwProcessId As Long _
                                ) As Long
'http://msdn.microsoft.com/ja-jp/library/cc364757.aspx
Private Declare PtrSafe Function GetWindow Lib "user32" ( _
                                ByVal hwnd As LongPtr, _
                                ByVal wCmd As Long _
                                ) As LongPtr

'http://msdn.microsoft.com/ja-jp/library/cc364718.aspx
Private Declare PtrSafe Function GetParent Lib "user32" ( _
                                ByVal hwnd As LongPtr _
                                ) As LongPtr

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

'http://msdn.microsoft.com/ja-jp/library/cc364701.aspx
Private Declare PtrSafe Function GetLastActivePopup Lib "user32" ( _
                                ByVal hwndOwnder As LongPtr _
                                ) As LongPtr

'http://msdn.microsoft.com/ja-jp/library/cc364621.aspx
Private Declare PtrSafe Function GetDlgItem Lib "user32" ( _
                                ByVal hDlg As LongPtr, _
                                ByVal nIDDlgItem As Long _
                                ) As LongPtr

Private 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

'http://support.microsoft.com/kb/242308/ja
'EnumWindows
Private Function ProcIDFromWnd(ByVal hwnd As LongPtr) As Long
   Dim idProc As Long
   
   ' Get PID for this HWnd
   GetWindowThreadProcessId hwnd, idProc
   
   ' Return PID
   ProcIDFromWnd = idProc
End Function
      
Private Function GetWinHandle(hInstance As Long) As LongPtr
   Dim tempHwnd As LongPtr
   
   ' Grab the first window handle that Windows finds:
   tempHwnd = FindWindow(vbNullString, vbNullString)
   
   ' Loop until you find a match or there are no more window handles:
   Do Until tempHwnd = 0
      ' Check if no parent for this window
      If GetParent(tempHwnd) = 0 Then
         ' Check for PID match
         If hInstance = ProcIDFromWnd(tempHwnd) Then
            ' Return found handle
            GetWinHandle = tempHwnd
            ' Exit search loop
            Exit Do
         End If
      End If
   
      ' Get the next window handle
      tempHwnd = GetWindow(tempHwnd, GW_HWNDNEXT)
   Loop
End Function

Sub OpenAccdrWithPassword( _
            targetDBFullPath As String, _
            pswd As String, _
            Optional WindowStyle As VbAppWinStyle = vbNormalFocus)
            
    Dim taskID As Long
    Dim targetDBHwnd As LongPtr
    Dim pswdDlgHwnd As LongPtr
    Dim dlgEditHwnd As LongPtr, dlgButtonOKHwnd As LongPtr
    
    If Dir(targetDBFullPath) = "" Then Exit Sub
    
    taskID = Shell("msaccess.exe /runtime " & _
                    targetDBFullPath, _
                    WindowStyle)
    'hInstanceなのか？
    targetDBHwnd = GetWinHandle(taskID)
    
    Do
        pswdDlgHwnd = GetLastActivePopup(targetDBHwnd)
    Loop While targetDBHwnd = pswdDlgHwnd
    
    dlgEditHwnd = GetDlgItem(pswdDlgHwnd, IDC_EDIT)
    dlgButtonOKHwnd = GetDlgItem(pswdDlgHwnd, IDOK)

    SendMessage dlgEditHwnd, WM_SETTEXT, 0, ByVal pswd
    SendMessage dlgButtonOKHwnd, BM_CLICK, 0, 0
End Sub