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.

 

[Mary7903]

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

Hi Jim Thank you for this code. It is just brilliant! I'm trying to run the macro but get this message: Run-time error '1004' Unable to get the find property of the WorksheetFunction Class for this line: Pos = WorksheetFunction.Find("A1:A3", cell.Offset(, -1)).Pleasehelps

 

[Mary7903]

Hi Jim Thank you for this code. It is just brilliant! I'm trying to run the macro but get this message: Run-time error '1004' Unable to get the find property of the WorksheetFunction Class for this line: Pos = WorksheetFunction.Find("A1:A3", cell.Offset(, -1)).Could you please help??

 

[Worf]

The code below expects a compound name like “John Woo” at column A, if you have “Rocky”, without the space, the error occurs.

Sub DoBirthdayRoutine()
Dim olApp As Outlook.Application, cell As Range, Msg$, mi As MailItem
Set olApp = New Outlook.Application
Sheets("Sheet1").Activate
For Each cell In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    If Month(cell) = Month(Date) And Day(cell) = Day(Date) Then
        Msg = "Dear " & Left(cell.Offset(, -1), WorksheetFunction.Find(" ", cell.Offset(, -1)) - 1) & ","
        Set mi = olApp.CreateItem(olMailItem)
        With mi
            .To = cell.Offset(, 1)
            .Subject = "Happy B'day"
            .Body = Msg & vbNewLine & " Happy Birthday to you and many more happy returns." & vbCrLf
            .Display
        End With
    End If
Next
Application.ScreenUpdating = True
End Sub

 

[Tbarsiq]

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

Hello John,

Can you kindly advise on how to include e-mails in CC aside to the original employee with a B.day occurrence in the VBA & how to include a picture too ?

Thanks a lot in advance

 

[Worf]

The tags on the HTML line will not display correctly here. Replace “[“ with “<” and “]” with “>”for the code to work properly.

' Excel module
Sub DoBirthdayRoutine()
Dim olApp As Outlook.Application, MItem As MailItem, cell As Range, _
pa As PropertyAccessor, att As Attachment
Const PR_ATTACH_CONTENT_ID = "[URL]http://schemas.microsoft.com/mapi/proptag/0x3712001F[/URL]"
Set olApp = New Outlook.Application
Application.ScreenUpdating = False
Sheets("Sheet1").Activate
For Each cell In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    If Month(cell) = Month(Date) And Day(cell) = Day(Date) Then
        Set MItem = olApp.CreateItem(olMailItem)
        With MItem
            .To = cell.Offset(, 1)
            .CC = cell.Offset(, 2)
            .Subject = "Happy Birhday"
            Set att = .Attachments.Add("d:\pub\uqm.jpg")                ' the image
            Set pa = att.PropertyAccessor
            pa.SetProperty PR_ATTACH_CONTENT_ID, "uqm.jpg"
          
          '  .HTMLBody = "[BODY][IMG src=""cid:uqm.jpg""] [/BODY]"
            .Display
        End With
    End If
Next
Application.ScreenUpdating = True
End Sub