SendKeys and Outlook Object Model Guard

[Howard Kaikow]

Has MSFT really disabled the ability to use SendKeys with the Outlook Object
Model Guard warning using VB/VBA?

I've constructed the following example for Outlook 2003.
Requires a reference to CDO.

Option Explicit
Option Compare Text
' API declarations
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub TestSimpleGetInternetHeaders()
SimpleGetInternetHeaders Application
End Sub

Public Sub SimpleGetInternetHeaders(appOutlook As Outlook.Application)
'Note Bene: A Reference to CDO 1.21 is used in Outlook 2003
Dim oSession As MAPI.Session
Dim oMessage As Message
Dim strEntryID As String
Dim strHeaders As String

Set oSession = New MAPI.Session
oSession.Logon "", "", False, False

For Each oMessage In
oSession.GetDefaultFolder(CdoDefaultFolderInbox).Messages
strEntryID = appOutlook.ActiveInspector.CurrentItem.EntryID

On Error Resume Next
Debug.Print "Outlook Data Guard warning is displayed"
strHeaders = oSession.GetMessage(strEntryID).Fields. _
Item(CdoPR_TRANSPORT_MESSAGE_HEADERS).Value 'Display the header
Debug.Print Err.Number, Err.Description ' Does not print without
dismissing dialog
Debug.Print "Does not print without dismissing dialog"
SendKeys "{TAB 3}(ENTER)": Sleep 50: DoEvents
Debug.Print "SendKeys has executed, but to what effect, since dialog
had already been dismissed?"
Debug.Print strHeaders
Err.Clear
Exit For
Next

oSession.Logoff

Set oSession = Nothing
Set oMessage = Nothing
End Sub

 

[Howard Kaikow]

SendKeys "{TAB 3}(ENTER)": Sleep 50: DoEvents
Should be

SendKeys "{TAB 3}{ENTER}": Sleep 50: DoEvents

I have this right in ny code, but I messed up entering it in the newsgroup.

 

[Howard Kaikow]

Bingo!

http://support.microsoft.com/kb/290500/EN-US/ states

"Outlook does not allow access to certain dialog boxes by using the
Microsoft Visual Basic or Microsoft Visual Basic for Applications SendKeys
command. This prevents malicious programs from automatically dismissing the
warning messages and circumventing the new security features."

 

[Howard Kaikow]

My original posting had obvious inefficiencies and did not do what I
intended.
Corrected code is given below.

In any case, SendKeys apparently cannot be used via VB/VBA to dismiss the
Object Guard dialog.

Option Explicit
Option Compare Text
' API declarations
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub TestSimpleGetInternetHeaders()
SimpleGetInternetHeaders Application
End Sub

Public Sub SimpleGetInternetHeaders(appOutlook As Outlook.Application)
'Note Bene: A Reference to CDO 1.21 is used in Outlook 2003
Dim oSession As MAPI.Session
Dim oMessage As Message
Dim strHeaders As String

Set oSession = New MAPI.Session
With oSession
.Logon "", "", False, False
On Error Resume Next
For Each oMessage In
..GetDefaultFolder(CdoDefaultFolderInbox).Messages
Debug.Print "Outlook Data Guard warning is displayed"
'Display the headers
strHeaders = .GetMessage(oMessage.ID).Fields. _
Item(CdoPR_TRANSPORT_MESSAGE_HEADERS).Value
Debug.Print Err.Number, Err.Description ' Does not print
without dismissing dialog

' Per MSFT KB article 290500
'"Outlook does not allow access to certain dialog boxes by
using the
'Microsoft Visual Basic or Microsoft Visual Basic for
Applications SendKeys
'command. This prevents malicious programs from
automatically dismissing the
'warning messages and circumventing the new security
features."

' SendKeys has no effect since dialog has already been
dismissed."
SendKeys "{TAB 3}{ENTER}": Sleep 50: DoEvents
Debug.Print strHeaders
Err.Clear
Next
On Error GoTo 0
.Logoff
End With

Set oSession = Nothing
Set oMessage = Nothing
End Sub