Monthly E-Mails

G

Gabe

I have some code that automatically sends e-mails each month to different
poeple. Each month the e-mails are different (for example: In January I send
2 e-mails and in Febuary I send 3 e-mails). So now I have been forced to make
a separate code under a different module for each month of the year. The
problem is that when I have to add a new e-mail contact to the list, I have
to spend hours changing each code(one for each month of the year). Is there a
way to make only one code but then specify who to include in each month? So
that I can just change 1 code and not 12? Here is an example of what it looks
like:

Sub January()'Module 1
Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(olMailItem)
With olMsg
.To = "(e-mail address removed)"
.Subject = "Monthly Report"
.Display
End With
Set olMsg = Nothing
Set olApp = Nothing
Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(olMailItem)
With olMsg
.To = "(e-mail address removed)"
.Subject = "Monthly Report"
.Display
End With
Set olMsg = Nothing
Set olApp = Nothing
End Sub


Sub Febuary()'Module 2
Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(olMailItem)
With olMsg
.To = "(e-mail address removed)"
.Subject = "Monthly Report"
.Display
End With
Set olMsg = Nothing
Set olApp = Nothing
Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(olMailItem)
With olMsg
.To = "(e-mail address removed)"
.Subject = "Monthly Report"
.Display
End With
Set olMsg = Nothing
Set olApp = Nothing
Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(olMailItem)
With olMsg
.To = "(e-mail address removed)"
.Subject = "Monthly Report"
.Display
End With
Set olMsg = Nothing
Set olApp = Nothing
End Sub
 
G

Gabe

I am just learning VBA, really just a beginner... how/where would I specify
each e-mail to be sent on a particular month(s) of the year using the
month(date) procedure? Thanks for all of your help. It is very much
appriciated.

~Gabe
 
J

JP

I think what Michael was suggesting was something like a Select Case
statement. When you run the code it would automatically pick up the
current month (from the current date) and select the appropriate
recipients. Something like this:

Sub SendMonthlyMsgs()

Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Dim strRecip As Outlook.Recipient

Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(olMailItem)

' what month is it?
Select Case Month(Date)
Case 1 ' January
strRecip = "John Smith; Mary Jones"
Case 2 ' February
strRecip = "John Smith; Mary Jones;Mark Summers"
Case 3 ' March
strRecip = "John Smith; Mary Jones;Mark Summers;Jane Doe"

' ------------------
' more Case statements here
'------------------

End Select

With olMsg
.To = strRecip
.Subject = "Monthly Report"
.Display
End With

End Sub
 
G

Gabe

Hmmm...Actually there are 10 seperate messages all with different recipients
that I send each month. Each procedure varies by month, for example: I send 5
messages in Jan, then I send 7 messages in Feb etc...Is there a way to
specify the message itself so that I can see which months each message is
being sent? Kinda like this,

If month(date) = 1,3,4,5,6,7,8,9,10,11,12 Then 'If the current date matches
any of these months, then send this message
With olMsg
.To = "(e-mail address removed)"
.Subject = "Monthly Report"
.Display
End With

If month(date) = 1,5,6,7,8,9,10,11,12 Then 'If the current date matches any
of these months, then send this message
With olMsg
.To = "(e-mail address removed)"
.Subject = "Monthly Report"
.Display
End With
 
G

Gabe

No different messages to different people each month.

Jan
Email1 - To: John, Joe, Jane
Email2 - To: Bob, Ben, Bill
Email3 - To: Mark, Mike, Max

Feb
Email1 - To: Sam, Sue, Sarah
Email2 - To: John, Joe, Jane
Eamil3 - To: Jake, Josh, John
 
G

Gabe

I think I answered my own question, I just had to put in a case statement in.
Here is the final. Thanks again.

Sub MyFunction()
Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Dim MyMonth
MyMonth = Month(Date) 'current month
Select Case MyMonth
Case 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, 12 'if the current month
(MyMonth) equals these months then send this message
Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(olMailItem)
With olMsg
.To = "(e-mail address removed)"
.Subject = "Monthly Report"
.Attachments.Add ("C:\test.doc")
.Display
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><H>Hello,</H2><BODY><BLOCKQUOTE>Attached
is the monthly report.</BLOCKQUOTE></BODY></HTML><H><BODY>Thanks.</HTML>" &
..HTMLBody
End With
Set olMsg = Nothing
Set olApp = Nothing
End Select
Select Case MyMonth
Case 3, 4 'if the current month (MyMonth) equals these months then
send this message
Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(olMailItem)
With olMsg
.To = "(e-mail address removed)"
.Subject = "Monthly Report"
.Attachments.Add ("C:\test.doc")
.Display
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><H>Hello,</H2><BODY><BLOCKQUOTE>Attached
is the monthly report.</BLOCKQUOTE></BODY></HTML><H><BODY>Thanks.</HTML>" &
..HTMLBody
End With
Set olMsg = Nothing
Set olApp = Nothing
End Select
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top