Send e-mail automatically "happy birthday"

[JorgenKjer]

Hi

I seek help to solve this problem
I have a list of members in a Dynamic Range, I would like the board members,there are five, to automatically receive an e-mail on the day when one of the members has abirthday. Names of the members are in column B and birthday in column M.
The e-mail must be limited to a short text<o></o>
"Remember XXXXXXXXX's birthday dd-mmm"<o></o>
I hope there is someone who has a suggestion to solve the problem.<o></o>
<o> </o>
Kind regards<o></o>
Jorgen<o></o>

 

[Worf]

Hi

The checking will take place every time you activate that sheet:

' sheet module
Private Sub Worksheet_Activate()
Dim i%
For i = 1 To Range("b" & Rows.Count).End(xlUp).Row
    If Day(Now()) = Day(Cells(i, "m")) And Month(Now()) = Month(Cells(i, "m")) _
    Then send_mail i
Next
End Sub


Sub send_mail(r%)
Dim outapp As Outlook.Application, outmail As MailItem
Set outapp = CreateObject("Outlook.application")
Set outmail = outapp.CreateItem(olMailItem)
With outmail
    .To = Cells(r, "c")
    .cc = Cells(r, "d")
    .BCC = Cells(r, "e")
    .Subject = "Birthday"
    .Body = "Remember " & Cells(r, "b") & "'s birthday: " & _
    Format(Cells(r, "m"), "dd-mmm")
'    .Send
    .Display
End With
Set outmail = Nothing
Set outapp = Nothing
End Sub

 

[hicksi]

I was once asked how to do this with a Lotus Notes email service. Thankfully I was able to avoid the issue.

Anybody ever tried to make this work when using other email systems (including Hotmail or Gmail)?

 

[hicksi]

Actually... I have a process that analyses Operating Theatre lists and sends emails to various people based on conditions found.
The "Working" email bit is:

Public Function MailTextOutlook(sTo As String, sSubject As String, sBody As String, _
    Optional sCC As String, Optional sBCC As String, _
    Optional priority As OlImportance = olImportanceNormal, _
    Optional dtmExpire As Date, _
    Optional emailFlag As OlFlagIcon = olNoFlagIcon) As Boolean
'For Tips see: [URL]http://www.rondebruin.nl/win/winmail/Outlook/tips.htm[/URL]
'Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    If dtmExpire = 0 Then dtmExpire = DateAdd("d", 1, Now())
    MailTextOutlook = False
    On Error GoTo MailFailed
    With OutMail
        .To = sTo
        .CC = sCC
        .BCC = sBCC
        .Subject = sSubject
        If IsHTMLMail Then
            .HTMLbody = sBody
        Else
            .Body = sBody
        End If
        .Importance = priority
        .FlagIcon = emailFlag
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .DeleteAfterSubmit = True
        .ExpiryTime = dtmExpire
        .Send   'or use .Display
    End With
    MailTextOutlook = True
MailFailed:
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

Things that you might find interesting in here are:
- The .To, .CC and .Bcc all take standard email entries, including concatenated email addresses (using semi-colon), groups and Gmail/Hotmail addresses
- You can expire emails. It actually works and puts a strikethrough once expired (though not sure what it does on Gmail or Hotmail)
- If you want to be crazy and create HTML code as your "Birthday" text, then you can send a html message
- DeleteAfterSubmit means that you DO NOT have it in your Sent box.

 

[mmaan]

hello.....
i want your help regarding my dissertation work doing programming in macro. i want colour in 15 to 20 and then 36 to 41 and then same it should be repeat from 15 to 4199.please do needful

for i = 15 to 4199 step 21
cells(i,2).interior.colorindex = 6
next i

 

[JorgenKjer]

Hey Worf<o></o>
Thank youfor your prompt reply, the code works, I just had to adjust it a little to fit myRange.<o></o>
However, Ihave yet another challenge. The five board members who receive the mail to reminderthem of a member's birthday is themselves on the members list and do not need toreceive an email when they themselves have a birthday, but the rest of the board members need a reminder<o></o>
I hope thismages sense

Private Sub Worksheet_Activate()
Dim i%
For i = 6 To Range("b" & Rows.Count).End(xlUp).Row
If Day(Now()) = Day(Cells(i, 13)) And Month(Now()) = Month(Cells(i, 13)) Then
send_mail i
End If
Next
End Sub

Sub send_mail(r%)
Dim outapp As Outlook.Application, outmail As MailItem
Set outapp = CreateObject("Outlook.application")
Set outmail = outapp.CreateItem(olMailItem)
With outmail
.To = "board members_1;board members_2;board members_3;board members_4;board members_5"
'Cells(r, Cells(r, 9).Value)
'.cc = Cells(r, "d")
'.BCC = Cells(r, "e")
.Subject = "Birthday"
.Body = "Remember " & Cells(r, 2).Value & "'s birthday: " & _
Format(Cells(r, 13), "dd-mmm")
'.Send
.Display
End With
Set outmail = Nothing
Set outapp = Nothing

End Sub

 

[Worf]

New version:

Private Sub Worksheet_Activate()
Dim i%
For i = 6 To Range("b" & Rows.Count).End(xlUp).Row
    If Day(Now()) = Day(Cells(i, 13)) And Month(Now()) = Month(Cells(i, 13)) _
    Then send_mail i
Next
End Sub


Sub send_mail(r%)
Dim outapp As Outlook.Application, outmail As MailItem, tolist$, i%
Set outapp = CreateObject("Outlook.application")
Set outmail = outapp.CreateItem(olMailItem)
tolist = ""
For i = 6 To Range("b" & Rows.Count).End(xlUp).Row
    If i <> r Then tolist = tolist & Cells(i, "c") & ";"    ' emails at column C
Next
With outmail
.To = tolist
.Subject = "Birthday"
.Body = "Remember " & Cells(r, 2) & "'s birthday: " & _
Format(Cells(r, 13), "dd-mmm")
.Display
End With
Set outmail = Nothing
Set outapp = Nothing
End Sub

 

[Worf]

Hello mmaan

If you have a request that is not directly related to the thread’s subject, please start a new one.

Sub Colours()
Const maxrow As Long = 100
Dim i%
For i = 15 To maxrow Step 21
    Cells(i, 2).Resize(6).Interior.ColorIndex = 6
Next
End Sub