VBA code to send outlook mails

[witsonjoyet]

Hai all,

File link : https://www.dropbox.com/s/zidotz3nciabrzt/Birthday Reminders.xlsm


Again i came with some VBA doubt for my previous question. at last i have prepared nice excel birthday reminder which shows today's birthdays and coming 30 days birthdays. and i have put one button which sends mail to that concern person.


1)Now coming to the point in my VBA code allows me to send one mail to the one person. but now i want to change it as to send the mail to the first person (who has birthday on that day) and cc to all my colleagues.


2) The file don't allow me to send the wishes mail more than one person ,i.e. if today three people has birthdays then i should send mails to three of them. but in this macro it sends to one person only. How can i change the code as it allows to send mail to everyone.


3) If i want to send two people only is it possible to send as per my wish ?


And i wish to use this same file for give mails to festival wishes too.For festivals i have to send mail to every one right? so in another module (Mail to Everyone) which code should i write?

My code is as follows :

Sub sendmail()
'
' wishes Macro
'
Dim Outlookapp As Object
Dim Myitem As Object
Dim cell As Range
Dim subj As String
Dim emailaddr As String
Dim recipient As String
Dim bonus As String
Dim msg As String
Dim mailsubj As String
Dim msgcontent As String
Dim emailaddy As String
Dim emailaddyCC As String

Sheets("mail").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Documents and Settings\SYSTEM2\Desktop\wishes from SRV Team", Quality:=xlQualityStandard _
, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'email

'what you want the email to say msg=msg as much as you want chr13 means hit the return key

msg = msg & "Happy Birthday " & Chr(13) & Chr(13) & Chr(13)

Sheets("Reminder").Visible = True
'place the email addresses you want on the sheet user can then replace a name if necessary

'Sheets("reminder").Select

emailaddy = Worksheets("reminder").Range("d5").Value
'emailaddy = Application.vlookup(Worksheets("reminder").Range("a95").Value, Worksheets("sheet1").Range("c2:e17"), 2, False)

Set Outlookapp = CreateObject("Outlook.Application")
subj = "Birthday Wishes from SRV & Team "
emailaddress = emailaddy
CCRecipients = emailaddyCC

'gets outlook going, defines subject, who to send to, subject and message

Set Myitem = Outlookapp.createitem(0)
With Myitem
.To = emailaddress
.CC = CCRecipients
.Subject = subj
.body = msg

'need to know where file is saved

.Attachments.Add "C:\Documents and Settings\SYSTEM2\Desktop\Wishes from SRV Team.pdf"
.Display

' ActiveWorkbook.Save
'ActiveWindow.Close
End With


End Sub

Kindly find the link file for your reference.


Regards


Witson Joyet

 

[DeBeuz]

Hi,

Your To is comming from 'emailaddy = Worksheets("reminder").Range("d5").Value', so if yo fill that cell with all email addresses of persons having their birthday separated with a semicolon, it should send the mail to them.
The CC list if populated with 'CCRecipients = emailaddyCC', but emailaddyCC seems not to be filled.

I might be easier to collect the emailaddresses outside your sub and present the as arguments to the sub.
Outside your sendmail, you should go through the list of emailaddresses and birthdays.
If birthday is today add ";" & emailaddress to ToAddresses, otherwise add ";" &emailaddress to CCaddresses.
When finished, call sendmail( Toaddresses, CCaddresses ).

sub sendmail( ToAddresses As String, CCaddresses As String)
..
.To = Toaddresses
.CC = CCaddresses