automatic birthday wishes using excel and outlook.

[nidhinkg]

i have a excel file which contains Name(column A),DOB(column B), & email address(column C),.

i would like to send birthday wishes mail automatically to the people according to their bday.

there may be "n" number of people on a particular day. i would like to send a single mail to all the people.i am using microsoft outlook.

When i open that excel file, it should pop up the New Message window of outlook with all email ids in the To. field with "Happy B'day" as subject and Message body as :"many more happy returns of the day & have a nice n wonderful day ahead".



i am very new to excel n have no idea about VB also. pls pls pls help me.....

nidhin.

 

[rakeshthestorm]

Thanks, so glad It worked for you.

Jim

Dear Jim
I really liked the post by you. It worked for me too with slight adjustment as per my requirement.
I have further 2 more requirements:
1) I want to add 1 pic (inline attachment) of the recipient from the same/different folder (file name like <empcode>.jpg, eg 2835.jpg)
2) I want to add 1 jpg image (same for all mails) also as an inline attachment.

I tried with following code and I am able to attach the above mentioned attachments but they are appearing as separate attachments but not inline attachments.
Code used by me is :
Public Sub Workbook_Open()
Call DoBirthdayRoutine
End Sub


Public Sub DoBirthdayRoutine()

Dim olApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Msg, picName As String
Set olApp = New Outlook.Application
Application.ScreenUpdating = False
Sheets("Sheet1").Activate
LR = Range("B" & Rows.Count).End(xlUp).Row
For Each cell In Range("B2:B" & LR)
If Month(cell) = Month(Date) And Day(cell) = Day(Date) Then
'Pos = WorksheetFunction.Find(" ", cell.Offset(, -1))
FName = LTrim(RTrim(cell.Offset(, -1))) 'Left(cell.Offset(, -1), cell.Offset(, -1) - 1)
Subj = "Happy Birthday"
EmailAddr = cell.Offset(, 1).Value
''Msg = "<<this is a test message to check html>>" & vbNewLine
Msg = "Dear Mr. " & FName & "," & vbNewLine
Msg = Msg & vbNewLine & "A very Happy Birthday and many happy returns of the day to you. Have a wonderful day." & vbNewLine
Msg = Msg & vbNewLine & "Best Regards " & vbNewLine
Msg = Msg & "DCBL Team, Yadwad Project, Belgaum"
picName = LTrim(RTrim(cell.Offset(, 2))) & ".jpg"
Set MItem = olApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr
'.CC = "xyz@dalmiacement.com"
.Subject = Subj

.BodyFormat = olFormatRichText


.Body = "HAPPY BIRTHDAY" & vbNewLine & Msg
.Attachments.Add ("C:\Users\sharma.rakesh1\Desktop\hbty\" & picName)
.Attachments.Add ("C:\Users\sharma.rakesh1\Desktop\hbty\HBTY_templ.jpg")

.Send
End With
End If
Next

Application.ScreenUpdating = True

End Sub

---
Pl. help me
Regards
Rakesh Sharma, Manager, IT

 

[ROHIT5073]

I also have the same Query!!!! Could someone plz help!!!

 

[nitulkumar]

Hi Jim,
I used your code but I got a error in line 13 that is "Pos = WorksheetFunction.Find(" ", cell.Offset(, -1))"
so i am unable to send the messege to the recipients.refer the screenshot.

 

[nitulkumar]

Hi nidhinkg,
I used your code but I got a error in line 13 that is "Pos = WorksheetFunction.Find(" ", cell.Offset(, -1))"
so i am unable to send the messege to the recipients.refer the screenshot.Plz help to resolve that.

 

[banu4me]

Hi can u provide step by step process in excel 2012..

 

[kumar3698]

Hi Jim, Nidhi

Could pls share me the template with working macro of the same. Because when i try im getting the below error.

Run - Time error 1004
Unable to get the find property of the worksheetfunction class

I Have Column A - Name, Column B - DOB, Column C - Email.


Pls help

 

[Apurba Bhattacharyya]

Hi Mr. Jim May, I am Apurba Bhattacharyya from Kolkata, India. I have just joind mrexcel.com.

I was trying to execute this macro for auto mail generation. I was able to generate mail but facing one problem.
The mail body is looking like this (name is showing as blank). Please help.
[FONT=&quot]Dear ,[/FONT] <o></o>
[FONT=&quot] Happy Birthday to youand many more happy returns. Have a wonderful day.

[/FONT]Thanks in advance.
<o></o>

 

[jackcluseau]

Thanks, so glad It worked for you.

Jim

Hi Jim,

I was looking at your code for birthday wishes; awesome work. I am new to excel vba and need help with regard to drafting an outlook mail out of excel workbook.

I wonder if you can help me with a code that would change the page color of the outlook mail in the body or if the excel vba can apply randon patterns or textures from the page color option before sending the mail.

Looking forward to hear from you.

Regards,
Jack

 

[madforgolf]

Hi Mr. Jim May, I am Apurba Bhattacharyya from Kolkata, India. I have just joind mrexcel.com.

I was trying to execute this macro for auto mail generation. I was able to generate mail but facing one problem.
The mail body is looking like this (name is showing as blank). Please help.
Dear , <o></o>
Happy Birthday to youand many more happy returns. Have a wonderful day.

Thanks in advance.
<o></o>

"For Each cell In Range("B2:B" & LR)
If Month(cell) = Month(Date) And Day(cell) = Day(Date) Then
Pos = WorksheetFunction.Find(" ", cell.Offset(, -1))
FName = Left(cell.Offset(, -1), Pos - 1)
Subj = "Happy Birthday"
EmailAddr = cell.Offset(, 1).Value
Msg = "Dear " & FName & "," & vbNewLine
Msg = Msg & vbNewLine & " Happy Birthday to you and many happy returns."
Msg = Msg & vbNewLine & " Have a wonderful day." & vbCrLf & vbCrLf

Check that this line is the one you are adding
, works fine for me.

Marty

 

[sunil_sm_kapoor]

Please let me know where I can put this code in Outlook. I mean the steps.
Regards

While in your VBE window check to make sure, under Tools, References... you have Microsoft Outlook "CHECKED" before running the below Macro

This code sends a single e-mail to each person versus your request for 1 single e-mail to ALL

Post this code in a standard module, then run DoBirthdayRoutine.

Write back with questions.. Jim

Sub DoBirthdayRoutine()

Dim olApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Msg As String
Set olApp = New Outlook.Application
Application.ScreenUpdating = False
Sheets("Sheet1").Activate
LR = Range("B" & Rows.Count).End(xlUp).Row
For Each cell In Range("B2:B" & LR)
    If Month(cell) = Month(Date) And Day(cell) = Day(Date) Then
    Pos = WorksheetFunction.Find(" ", cell.Offset(, -1))
    FName = Left(cell.Offset(, -1), Pos - 1)
    Subj = "Happy B'day"
    EmailAddr = cell.Offset(, 1).Value
    Msg = "Dear " & FName & "," & vbNewLine
    Msg = Msg & vbNewLine & " Happy Birthday to you and many more happy returns.  Have a wonderful day." & vbCrLf & vbCrLf
    
Set MItem = olApp.CreateItem(olMailItem)
With MItem
    .To = EmailAddr
    .Subject = Subj
    .Body = Msg
    .Send
End With
End If
Next

Application.ScreenUpdating = True

End Sub