How to work around Outlook 2003 email security prompts?

[deko]

I need to automate the sending of email from Access and have been looking
for a way to get around the annoying security prompt:
"A program is trying to access e-mail addresses you have stored in Outlook
...."

I've looked at Outlook Redemption http://www.dimastr.com/redemption/

but I'm not sure this is the best solution for Outlook 2003 with
pop3/internet only mode.

One solution I've been considering is importing into the Outlook Contacts
folder all the email addresses stored in Access and using Outlook VBA (which
is NOT supposed to generate security prompts) to automate the sending of
email. But how to kick off Outlook VBA from Access?

Is the only other option to write my own COM Add In?

any help here is greatly appreciated....

 

[Mike]

Have you tried linking your Outlook data into Access? I'm not sure if this
will avoid the security prompt, but it would be an easy thing to try. Also,
what is it you are trying to automate?

Mike

 

[Ken Slovak - [MVP - Outlook]]

Outlook 2003 automation code run from Access would be subject to the
security prompts. It's only when the code is run from within the
Outlook 2003 VBA project that the security prompts won't fire. A COM
addin would work if all your Outlook objects are instantiated from the
Application object that is passed to you in the On_Connection event in
the addin.

I usually use Redemption myself since most of my addins are required
to run on multiple versions of Outlook.

 

[deko]

10-4

I'm not sure which is worse - living with the annoyance or adding complexity
to my app with Redemption.

I have another issue - I'm wondering if you can get me going in the right
direction - see post on 1/6/03 "How to get sent message dates using VBA"

 

[Ken Slovak - [MVP - Outlook]]

I don't see that post. Repost it in this thread.

10-4

I'm not sure which is worse - living with the annoyance or adding complexity
to my app with Redemption.

I have another issue - I'm wondering if you can get me going in the right
direction - see post on 1/6/03 "How to get sent message dates using

VBA"

 

[deko]

I don't see that post. Repost it in this thread.
Hi Ken,

Here's an expaned version of that post:

Is there a way to match MailItem properties with ContactItem properties
using VBA?

I'm trying to use VBA to pull all the messages (actually just the sent and
received date of each message) that belong to a particular contact. For
example, if I have a contact "John Doe" in the Contacts folder, I want code
to find all the dates on which I sent (or received) an email to this
contact.

Outlook must know how to associate a particular contact entry with it's
email messages in the PST. This is evidenced by opening an email message in
the InBox and right-clicking on the "From" header: I can select "Lookup
Contact" from the menu that appears and it will take me to that contact's
entry in the
Contacts folder. What I am trying to do is the same process in reverse.



I keep the contacts in my Access database synchronized with the Outlook
Contact folder with code that runs every time the database is opened - I
upload all the relevant contact info (email address, etc.) and an Entity_ID
(which goes in the "Body" field) to the Outlook Contacts folder. What I
need is a way to pull down all the dates in "Sent" and "Received" fields in
the InBox and Sent Items folder - based on the Entity_ID in the Outlook
Contacts form "Body" field. What I'm trying to do is populate a table that
has all the dates on which an email was sent and/or received to each
contact.



Here's a first crack at it... any help is much appreciated.




Public Sub GetMessages()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim olns As Outlook.Namespace
Dim ola As New Outlook.Application
Dim olfcn, olfsm As Outlook.MAPIFolder
Dim olci As Outlook.ContactItem
Dim olmi As Outlook.MailItem
Dim olit As Outlook.Items
Dim varC, varM As Variant
Dim varEid As Variant
Dim varSent As Variant
Dim strSubject As String

Set olns = ola.GetNamespace("MAPI")
Set olfsm = olns.GetDefaultFolder(olFolderSentMail)
Set olfcn = olns.GetDefaultFolder(olFolderContacts)
Set olit = olfsm.Items
Set olmi = olit.GetLast

For Each varC In olfcn.Items

'loop through each Contact in the Contacts folder that has an Entity_ID

If Not IsNull(varC.Body) And IsNumeric(varC.Body) Then
Debug.Print "varC EntryID = " & varC.EntryID
Debug.Print varC.Email1Address
'Debug.Print "olmi.To = " & olmi.To 'this is not associated with
Entity_ID
'below is what appears in "DisplayAs" in Contacts form, and
should match corresponding olmi.To
Debug.Print _
varC.FirstName & " " & _
varC.LastName & " " & _
varC.Suffix & _
"(" & varC.Email1Address & ")"

'now loop through each MailItem to find messages that belong to each
contact - this does not work properly...

For Each varM In olfsm.Items

'the problem here is finding a way to match the MailItem with the
ContactItem
'the only criteria I can find to match on is "To" (see MailItem
properties)
'I've tried EntryID - but they differ between ContactItem and MailItem
'perhaps if I could get the email address out of the MailItem?

'perhpas I am going about this all wrong?

'If olmi.EntryID = varC.EntryID Then
'If olmi.To = varC.Email1Address Then
If olmi.To = _
varC.FirstName & " " & _
varC.LastName & " " & _
varC.Suffix & _
"(" & varC.Email1Address & ")" _
Then
Debug.Print "found MailItem " & olit.Item(1)

'returns first subject in PST by date ascending (does
not associate with Eintity_ID)
Debug.Print olmi.To

'returns most recent email date sent in PST (does not
associate with Entity_ID)


'code to populate table with MailItem data - this is a rough
draft - needs work

Set rst = db.OpenRecordset("tblEmail")
rst.AddNew
rst!Entity_ID = olci.Body
rst!Sent = DateValue(CDate(varSent))
rst!Received = DateValue(CDate(varReceived))
rst.Update

End If
Next
End If
Next
End Sub

 

[deko]

some success with this if I set the DisplayAs field in the Contacts form to
the email address of the contact... but it's slow... I'm beginning to lose
hope...

Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim olns As Outlook.Namespace
Dim ola As New Outlook.Application
Dim olfcn, olfsm As Outlook.MAPIFolder
Dim olci As Outlook.ContactItem
Dim olmi As Outlook.MailItem
Dim olit As Outlook.Items
Dim varC, varM As Variant
Dim varEid As Variant
Dim varSent As Variant
Dim strSubject As String

Set olns = ola.GetNamespace("MAPI")
Set olfsm = olns.GetDefaultFolder(olFolderSentMail)
Set olfcn = olns.GetDefaultFolder(olFolderContacts)
Set olit = olfsm.Items
Set olmi = olit.FindNext

For Each varC In olfcn.Items
If Not IsNull(varC.Body) And IsNumeric(varC.Body) Then
For Each olmi In olfsm.Items
If olmi.To = varC.Email1Address Then
Debug.Print "**********email found**********"
Debug.Print "varC.Email1Address = " & varC.Email1Address
Debug.Print "olmi.To = " & olmi.To
Debug.Print "olmi.Subject = " & olmi.Subject
Debug.Print "olmi.SentOn = " & olmi.SentOn
End If
Next
End If
Next

 

[deko]

if anyone is interested:

http://support.microsoft.com/?kbid=324530

 

[deko]

This code will pull (from the Sent Items folder) the Address, Subject, and
Date Sent of each message sent to each Contact (that has an email address)
in the default Outlook Contacts folder.

The problem is speed - with 39 messages in my Sent Items folder, and less
than 50 contacts, this took about 5 minutes to run on a 1.5Ghz P4 with 512
Ram. I believe this is due to the fact that every message in the Sent Items
folder has to be replied to for each contact.

As is stated in KB article 324530: "The inability to directly return a fully
qualified e-mail address is a limitation of the Outlook object model."

Any suggestions on how to improve this are welcome!

Public Sub GetMessages()
Dim olns As Outlook.Namespace
Dim ola As New Outlook.Application
Dim olfcn, olfsm As Outlook.MAPIFolder
Dim olci As Outlook.ContactItem
Dim olmi, olmiRa As Outlook.MailItem
Dim varC As Variant
Dim olra As Outlook.Recipient
Dim olrsa As Outlook.Recipients
Set olns = ola.GetNamespace("MAPI")
Set olfsm = olns.GetDefaultFolder(olFolderSentMail)
Set olfcn = olns.GetDefaultFolder(olFolderContacts)
For Each varC In olfcn.Items
For Each olmi In olfsm.Items
Set olmiRa = olmi.ReplyAll
Set olrsa = olmiRa.Recipients
For Each olra In olrsa
If olra.Address = varC.Email1Address Then
Debug.Print "----------------------------"
Debug.Print "sent to: " & olra.Address
Debug.Print "sent on: " & olmi.SentOn
Debug.Print "subject: " & olmi.Subject
Debug.Print "----------------------------"
End If
Next
Set olmiRa = Nothing
Set olrsa = Nothing
Next
Next
Set olns = Nothing
Set olfsm = Nothing
Set olfcn = Nothing
End Sub

 

[Ken Slovak - [MVP - Outlook]]

CDO 1.21 is an order of magnitude faster than using the Outlook object
model but is not trusted even in trusted code so it will fire the
security prompts. For greatest speed without the security prompts I'd
look into using Redemption code (www.dimastr.com/redemption) and its
MAPITable and filter. Using that you could filter on various fields
such as the email addresses and it would be faster than using the
Outlook object model. The syntax is very MAPI'ish and not object
oriented though so it takes some getting used to.