Question abt Outlook 2003 VBA application by Sue Mosher*10152008

  • Thread starter Thread starter J.Alladien
  • Start date Start date
J

J.Alladien

Hello everybody,

I got the following code to automatically add recepients to contacts when
sending messages out to them:

' sample Outlook 2003 VBA application by Sue Mosher
' send questions/comments to (e-mail address removed)

' The Application_ItemSend procedure must go in the
' built-in ThisOutlookSession session module in Outlook VBA
Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
If Item.Class = olMail Then
Call AddRecipToContacts(Item)
End If
Set Item = Nothing
End Sub

' This procedure can go in any module
Sub AddRecipToContacts(objMail As Outlook.MailItem)
Dim strFind As String
Dim strAddress As String
Dim objNS As Outlook.NameSpace
Dim colContacts As Outlook.Items
Dim objContact As Outlook.ContactItem
Dim objRecip As Outlook.Recipient
Dim i As Integer
On Error Resume Next

' get Contacts folder and its Items collection
Set objNS = Application.GetNamespace("MAPI")
Set colContacts = _
objNS.GetDefaultFolder(olFolderContacts).Items

' process message recipients
For Each objRecip In objMail.Recipients
' check to see if the recip is already in Contacts
strAddress = AddQuote(objRecip.Address)
For i = 1 To 3
strFind = "[Email" & i & "Address] = " & _
strAddress
Set objContact = colContacts.Find(strFind)
If Not objContact Is Nothing Then
Exit For
End If
Next

' if not, add it
If objContact Is Nothing Then
Set objContact = _
Application.CreateItem(olContactItem)
With objContact
.FullName = objRecip.Name
.Email1Address = strAddress
.Save
End With
End If
Set objContact = Nothing
Next

Set objNS = Nothing
Set objContact = Nothing
Set colContacts = Nothing
End Sub

' helper function - put in any module
Function AddQuote(MyText) As String
AddQuote = Chr(34) & MyText & Chr(34)
End Function

I inserted the first part which is:

' sample Outlook 2003 VBA application by Sue Mosher
' send questions/comments to (e-mail address removed)

' The Application_ItemSend procedure must go in the
' built-in ThisOutlookSession session module in Outlook VBA
Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
If Item.Class = olMail Then
Call AddRecipToContacts(Item)
End If
Set Item = Nothing
End Sub

into "THIS OUTLOOK SESSION" and the rest of the code in"MODULE1",but when I
reply to a message the recepient doesn't get added!

As I am more experienced in MS Access I know that you have to somehow
"trigger" these codes to work properly ,can somebody advise me if I am on the
right track,and if not supply me with the steps to come on the right track!

BUT I HAVE ANOTHER IMPORTANT QUESTION:
**WILL THIS AUTOADD_CODE WORK WITH AUTOREPLIES??**

Cause I tried it in Outlook express and there It did not work,it only worked
when I "manually" replied!


Thanks in advance
 
Please see my response on your original thread at
http://www.microsoft.com/communitie...eral&mid=26857935-6d73-45a0-9093-6e45b4a4454e
.. You don't need to start the conversation over in another newsgroup.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54




J.Alladien said:
Hello everybody,

I got the following code to automatically add recepients to contacts when
sending messages out to them:

' sample Outlook 2003 VBA application by Sue Mosher
' send questions/comments to (e-mail address removed)

' The Application_ItemSend procedure must go in the
' built-in ThisOutlookSession session module in Outlook VBA
Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
If Item.Class = olMail Then
Call AddRecipToContacts(Item)
End If
Set Item = Nothing
End Sub

' This procedure can go in any module
Sub AddRecipToContacts(objMail As Outlook.MailItem)
Dim strFind As String
Dim strAddress As String
Dim objNS As Outlook.NameSpace
Dim colContacts As Outlook.Items
Dim objContact As Outlook.ContactItem
Dim objRecip As Outlook.Recipient
Dim i As Integer
On Error Resume Next

' get Contacts folder and its Items collection
Set objNS = Application.GetNamespace("MAPI")
Set colContacts = _
objNS.GetDefaultFolder(olFolderContacts).Items

' process message recipients
For Each objRecip In objMail.Recipients
' check to see if the recip is already in Contacts
strAddress = AddQuote(objRecip.Address)
For i = 1 To 3
strFind = "[Email" & i & "Address] = " & _
strAddress
Set objContact = colContacts.Find(strFind)
If Not objContact Is Nothing Then
Exit For
End If
Next

' if not, add it
If objContact Is Nothing Then
Set objContact = _
Application.CreateItem(olContactItem)
With objContact
.FullName = objRecip.Name
.Email1Address = strAddress
.Save
End With
End If
Set objContact = Nothing
Next

Set objNS = Nothing
Set objContact = Nothing
Set colContacts = Nothing
End Sub

' helper function - put in any module
Function AddQuote(MyText) As String
AddQuote = Chr(34) & MyText & Chr(34)
End Function

I inserted the first part which is:

' sample Outlook 2003 VBA application by Sue Mosher
' send questions/comments to (e-mail address removed)

' The Application_ItemSend procedure must go in the
' built-in ThisOutlookSession session module in Outlook VBA
Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
If Item.Class = olMail Then
Call AddRecipToContacts(Item)
End If
Set Item = Nothing
End Sub

into "THIS OUTLOOK SESSION" and the rest of the code in"MODULE1",but when I
reply to a message the recepient doesn't get added!

As I am more experienced in MS Access I know that you have to somehow
"trigger" these codes to work properly ,can somebody advise me if I am on the
right track,and if not supply me with the steps to come on the right track!

BUT I HAVE ANOTHER IMPORTANT QUESTION:
**WILL THIS AUTOADD_CODE WORK WITH AUTOREPLIES??**

Cause I tried it in Outlook express and there It did not work,it only worked
when I "manually" replied!


Thanks in advance
Click to expand...
 
Back
Top