Here is my code to kill the Outlook permission dialog
I am still learning Vb.Net, my experience is in Excel VBA
& VB, so the code could probably be improved. It launches
a second thread that looks out for the dialog, before the
primary thread accesses Outlook
Dermot Balson
Free VBA code for user interfaces, internet connectivity,
encryption
http://www.webace.com.au/~balson/InsaneExcel/Default.html
Last updated August 2003
***** this is the bit that runs the class ****
Dim OK As New oKiller
OK.SearchAndDestroy()
'Your code to access Outlook follows here
'CODE
'it will trigger the dialog, and the killer class should
'deal with it
'when you have finished, you can stop the killer class
like this
OK.Quit
'it is timed to quit after 15 min anyway, because it
gives permission for one minute only, and the dialog may
come up more than once
*********************************************
***** the class follows **********************
'When you access Outlook folders, a permissions dialog
pops up. This class fills in the dialog for the user
Imports System.Threading
Public Class oKiller
#Region "Declarations"
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const SC_RETURN = &H1C
Private Const BM_SETCHECK = &HF1
Private Const BST_CHECKED = &H1&
Private Const KEYEVENTF_KEYUP = &H2
Private Declare Sub keybd_event Lib "user32" (ByVal bVk
As Byte, ByVal bScan _
As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo
As Integer)
Private Declare Function GetForegroundWindow
Lib "user32" () As Integer
Private Declare Function GetDesktopWindow Lib "user32"
() As Integer
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Integer, ByVal wCmd As Integer) As
Integer
Private Declare Function GetWindowText Lib "user32"
Alias "GetWindowTextA" _
(ByVal hwnd As Integer, ByVal lpString As String,
ByVal cch As Integer) As Integer
Private Declare Function GetClassName Lib "user32"
Alias "GetClassNameA" _
(ByVal hwnd As Integer, ByVal lpClassName As String,
_
ByVal nMaxCount As Integer) As Integer
Private Declare Function SetForegroundWindow
Lib "user32" _
(ByVal hwnd As Integer) As Integer
Private Declare Function SendMessage Lib "user32"
Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg
As Integer, ByVal wParam As Integer, ByVal lParam As
Integer) As Integer
Private Declare Function BringWindowToTop Lib "user32"
(ByVal hwnd As Integer) As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal
dwMilliseconds As Integer)
Private Declare Function PostMessage Lib "user32"
Alias "PostMessageA" (ByVal hwnd As Integer, ByVal wMsg
As Integer, ByVal wParam As Integer, ByVal lParam As
Integer) As Integer
#End Region
Dim hDialog As Integer
Dim hCheckbox As Integer
Dim hButton As Integer
Dim FoundhWnd As Integer
Dim PrevhWnd As Integer
Dim t As System.Threading.Thread
'this is the public method used to start this class
Public Sub SearchAndDestroy()
'it needs to be on a separate thread because the main
thread is waiting
'for Outlook to respond, and for the same reason it
needs to be launched
'just before the main thread accesses the Outlook
folders
'this method will run the thread for up to 60
seconds, waiting for the
'dialog window to appear
t = New System.Threading.Thread(AddressOf LieInWait)
t.Start()
End Sub
'this method looks for the dialog window every split
second, for 15 minutes, then exits
Private Sub LieInWait()
Dim Counter As Integer
Dim u As Boolean
Do
'search every 0.25 seconds
Thread.CurrentThread.Sleep(250)
u = SearchForWindow()
Counter += 1
Loop While Counter < 3600
End Sub
'this method allows the main thread to terminate this
class when it is not needed
'any more
Public Sub Quit()
t.Abort()
End Sub
'this function does most of the work, waiting for the
dialog to appear
Private Function SearchForWindow() As Boolean
Dim hwnd As Integer
Dim t As Single, r As Integer, t2 As Single
Dim sWindowText As String, sClassname As String
'has the active window changed?
hwnd = GetForegroundWindow
If hwnd <> PrevhWnd Then
'get the window and class names
sWindowText = Space(255)
r = GetWindowText(hwnd, sWindowText, 255)
sWindowText = Left(sWindowText, r)
sClassname = Space(255)
r = GetClassName(hwnd, sClassname, 255)
sClassname = Left(sClassname, r)
'Check that window matches the search parameters
If (sClassname = "#32770") And sWindowText
= "Microsoft Outlook" Then
hDialog = hwnd
'get the dialog details and kill it
KillDialog()
SearchForWindow = True
'try to restore previous app that was in front
SetForegroundWindow(PrevhWnd)
Exit Function
End If
End If
'remember current active window
PrevhWnd = hwnd
End Function
'this method kills the Outlook dialog
'it has the handle of the dialog
Private Sub KillDialog()
'get handles of controls on form
FindWindowLike(hDialog)
'exit if we didn't find any handles
If hCheckbox = 0 Or hButton = 0 Then Exit Sub
'tick checkbox
Call SendMessage(hCheckbox, BM_SETCHECK, BST_CHECKED,
0&)
'press Yes button
PostMessage(hButton, WM_LBUTTONDOWN, 0, 5) ' wParam,
lParam = x,y
Sleep(50)
PostMessage(hButton, WM_LBUTTONUP, 0, 5)
Sleep(50)
'pass an Enter keystroke as well because sometimes
clicking the button is
'not enough to make the dialog disappear
Call keybd_event(13, 0, 0, 0)
Call keybd_event(13, SC_RETURN, KEYEVENTF_KEYUP, 0)
End Sub
'this function finds all the child windows and is used
to get the
'handles of the child controls on the Outlook dialog
Private Function FindWindowLike(ByVal hWndStart As
Integer) As Integer
Dim hwnd As Integer
Dim sWindowText As String
Dim sClassname As String
Dim r As Integer
'Hold the level of recursion and
'hold the number of matching windows
'Initialize if necessary
If hWndStart = 0 Then hWndStart = GetDesktopWindow()
'Get first child window
hwnd = GetWindow(hWndStart, GW_CHILD)
Do Until hwnd = 0
'Search children by recursion
Call FindWindowLike(hwnd)
'Get the window text and class name
sWindowText = Space(255)
r = GetWindowText(hwnd, sWindowText, 255)
sWindowText = Left(sWindowText, r)
sClassname = Space(255)
r = GetClassName(hwnd, sClassname, 255)
sClassname = Left(sClassname, r)
'look for Yes button and access dropdown
Select Case sWindowText
Case "Yes"
hButton = hwnd
Case "&Allow access for"
hCheckbox = hwnd
End Select
'Get next child window
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
FindWindowLike = 0
End Function
End Class
