Code:
Public Sub AnniversaryMail()
Dim objAppl As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objContact As Outlook.ContactItem
Dim objNewmail As MailItem
Dim objDrafts As MAPIFolder
Dim objVorlage As MailItem
On Error Resume Next
Set objAppl = CreateObject("Outlook.Application")
Set objNS = objAppl.GetNamespace("MAPI")
Set objDrafts = objNS.GetDefaultFolder(olFolderDrafts)
For Each objContact In objNS.GetDefaultFolder(olFolderContacts).Items.Restrict("[MessageClass] = 'IPM.Contact'")
If (Day(objContact.Birthday) = Day(Date)) And (Month(objContact. Anniversary) = Month(Date)) Then
Set objNewmail = Application.CreateItem(olMailItem)
With objNewmail
.Subject = "Happy Anniversary!"
.Recipients.Add objContact.Email1DisplayName
.Body = "Dear " & objContact.FirstName & ","
Set objVorlage = objDrafts.Items.Find("[Subject] = ""Happy Anniversary!""")
If Not objVorlage Is Nothing Then
.Body = .Body & objVorlage.Body
Else
.Body = "Happy Anniversary!"
End If
'.Display
.Send
End With
End If
Next objContact
End Sub
This is the code that I discussed in previous post. Check b'days in the contacts folders and sent emails to all those who have a Anniversary on the basis of a draft in the Drafts folder.
The question is, Outlook does not support Application.OnTime function, which would fully automate the process.
So I want to settle for a solution based on Excel.
Bookmarks