Macro Rule To Send Email Based On Appointment Time in Microsoft Outlook 2003

I would like to create a Microsoft Outlook 2003 macro / rule  to automatically send an email when the following conditions exist for a new appointment:

(If category does not equal 'Family' OR 'NCFPP') AND appointment time = ((WEEKEND) any) OR ((WEEKDAY) starts before 8:00 AM OR starts after 5:00 PM OR ends after 5:00 PM)

The idea is, I want to send my wife an email that says,
Subject: After Hours Work Notification
Body:

Hello My Love,

I just wanted you to make you aware of the following appointment. Let me know if this represents a conflict for anything you had planned. You may find details below:

{Appointment.Subject Line}
Where: {Appointment.Location} if null = 'Unspecified'
Start: {Appointment.StartTime}
End: {Appointment.EndTime}
Notes:
{Appointment.Body}

I'd like Outlook to automatically send out this email anytime an appointment is put on my calendar that occurs before or after business hours (8-5 M-F) and does not have the Outlook category of Family or NCFPP. The latter conditions prevent my wife from receiving  notifications for family events that she put on my calendar or sends me invites for.

I thank you for your help in advance. I'm not a coder, so I'll need some hand-holding on the macro code.

Thanks,
nss39759
nss39759Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

David LeeCommented:
Hi, nss39759.

The code below should take care of this for you.  I gave it a quick test, but did not test all possible conditions.  Follow these instructions to use it.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession
4.  Copy the code from the Code Snippet box and paste it into the right-hand pane of
5.  Outlook's VB Editor window
6.  Edit the code as needed.  I included comment lines wherever something needs to or can change
7.  Click the diskette icon on the toolbar to save the changes
8.  Close the VB Editor
9.  Click Tools > Macro > Security
10. Set the Security Level to Medium
11. Close Outlook
12. Start Outlook
13. Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run.  Say yes.

Sending a message via code will trigger Outlook's built-in security.  Outlook security cannot be turned off, but there are ways to work around it.

1.  Sign the code.  Here's a link to instructions on doing that: http://msdn.microsoft.com/en-us/library/aa155754(office.10).aspx
2.  Use ClickYes (http://www.contextmagic.com/express-clickyes/), a small utility that'll click the Yes button for you.  It creates a security hole though, since a virus could start sending messages and ClickYes would click the Yes button for it too.  
3.  Use Redemption (http://www.dimastr.com), a COM library that enables code to safely bypass Outlook security.

Dim WithEvents olkCalendar As Outlook.Items
 
Private Sub Application_Quit()
    Set olkCalendar = Nothing
End Sub
 
Private Sub Application_Startup()
    Set olkCalendar = Outlook.Session.GetDefaultFolder(olFolderCalendar).Items
End Sub
 
Private Sub olkCalendar_ItemAdd(ByVal Item As Object)
    Dim olkMsg As Outlook.MailItem, bolSendMsg As Boolean
    If InStr(1, Item.Categories, "Family") Or InStr(1, Item.Categories, "NCFPP") Then
        'Nothing to do'
    Else
        Select Case Weekday(Item.Start)
            Case vbSaturday, vbSunday
                bolSendMsg = True
            Case Else
                Select Case Hour(Item.Start)
                    Case 0 To 7
                        bolSendMsg = True
                    Case 17 To 23
                        bolSendMsg = True
                End Select
                If (Hour(Item.End) >= 17) Or (Hour(Item.End) < 8) Then bolSendMsg = True
        End Select
        If bolSendMsg Then
            Set olkMsg = Outlook.Application.CreateItem(olMailItem)
            With olkMsg
                .Subject = "After Hours Work Notification"
                .HTMLBody = "Hello My Love,<br><br>" _
                    & "I just wanted you to make you aware of the following appointment. Let me know if this represents a conflict for anything you had planned. You may find details below:<br><br>" _
                    & Item.Subject & "<br>" _
                    & "Where: " & IIf(Item.Location = "", "Unspecified", Item.Location) & "<br>" _
                    & "Start: " & Item.Start & "<br>" _
                    & "End: " & Item.End & "<br>" _
                    & "Notes: " & Item.Body
                .Send
            End With
        End If
    End If
    Set olkMsg = Nothing
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
nss39759Author Commented:
BlueDevilFan,

Thank you so much for your input.

This looks just like what I envisioned. Couple of things:

1.) I am already using a VB macro that uses "ThisOutlookSession". Can I append this code to that or do I need to create a new object?

2.) I'd like the email to be sent without any interaction from me. Where do I set the recipients of this email? (for example; wife.home@mail.com; wife.work@mail.com)

3.) Will this macro be applied to any new calendar items meeting the specified criteria or just the ones I manually create? Ideally, I'd like this macro to fire even when I accept invites that meet the criteria.

Thanks again for you help.

Regards,
nss39759
0
David LeeCommented:
"Thank you so much for your input."
You're welcome.

"Can I append this code to that or do I need to create a new object?"
Append it.  Outlook only allows one ThisOutlookSession module.  If the code you have already uses the Application_Startup and/or Application_Quit subroutines, then merge the code I provided into them.

"Where do I set the recipients of this email?"
Oops.  I forgot to include that.  Add the following lines of code anywhere between lines 30 and 40.

    .Recipients.Add "wife.home@mail.com"
    .Recipients.Add "wife.work@mail.com"
    .Recipients.ResolveAll

"Will this macro be applied to any new calendar items"
Yes.  The ItemAdd event fires any time an item is added to the calendar.  It doesn't matter how the item is added.  
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

nss39759Author Commented:
Good Day BlueDevilFan,

The previously existing macro code that I mentioned before is a short custom script that works together with an application on my BlackBerry. The application on my BlackBerry adds every phone call to my calendar. The macro script simply monitors the calendar for new entries and adds a specified Outlook Category to each new item.

As I stated before, I'm not a coder so the code is a little elementary and is an adaptation of a macro that I found online. As we've discussed, this macro uses the ThisOutlookSession module and should be merged with the code that you've provided. However, there are a few details that I've observed that I'd like to bring to your attention before I possibly blow something up. :)

I've included my previously existing code as snippet for comparison and your review:

1. Your code begins with,
"Dim WithEvents olkCalendar As Outlook.Items"
while the preexisting code begins with,
"Public WithEvents olkCalendar As Outlook.Items"

Which line should I use? Does it matter?

2. The preexisting code adds a specified category to every item. I'd like to modify the preexisting code to add the specified category only to items beginning with "Call{space} ".

This will allow me to add an "Or InStr(1, Item.Categories, "Phone")" statement to the new code to ignore phone calls. I'd hate for my wife to receive an email everytime my phone rings after hours.

Thank you for all your help thus far. I've learned a lot.

Regards,
nss39759
Public WithEvents olkCalendar As Outlook.Items
 
Private Sub Application_Quit()
 
Set olkCalendar = Nothing
 
End Sub
 
Private Sub Application_Startup()
 
Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items
 
End Sub
 
Private Sub olkCalendar_ItemAdd(ByVal Item As Object)
 
'Change the category name as desired
 
Item.Categories = "Phone"
 
Item.Save
 
End Sub

Open in new window

0
nss39759Author Commented:
Good Day BlueDevilFan,

To clarify on item 2, I was thinking of adding an if/then statement that basically said,
 if Item.Subject? begins with "Call{space} then
      Item.Categories = "phone" and "ignore1" (How do I add additional categories?)
      Item.Save
else
     'Nothing to do'

I know I probably murdered the code but hopefully the logic is intact. As I mentioned in parentheses, I'd like to know how to add categories on this line so that I can expand the code's use later.

Thanks again,
nss39759
0
nss39759Author Commented:
Good Day BlueDevilFan,

     I've managed to hack together some code that appears to work. I thought it wise to post it for your review. Are there any major issues with the code below?

Regards,
nss39759
Public WithEvents olkCalendar As Outlook.Items
 
Private Sub Application_Quit()
 
Set olkCalendar = Nothing
 
End Sub
 
Private Sub Application_Startup()
 
Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items
 
End Sub
 
Private Sub olkCalendar_ItemAdd(ByVal Item As Object)
    Dim olkMsg As Outlook.MailItem, bolSendMsg As Boolean
    
'Change the category name as desired
If InStr(1, Item.Subject, "Call ") Then
    Item.Categories = "BUSINESS, Phone Calls"
    Item.Save
Else
    If InStr(1, Item.Categories, "Family") Or InStr(1, Item.Categories, "NCFPP") Or InStr(1, Item.Categories, "Phone Calls") Then
        'Nothing to do'
    Else
    Item.Categories = "BUSINESS"
        Select Case Weekday(Item.Start)
            Case vbSaturday, vbSunday
                bolSendMsg = True
            Case Else
                Select Case Hour(Item.Start)
                    Case 0 To 7
                        bolSendMsg = True
                    Case 17 To 23
                        bolSendMsg = True
                End Select
                If (Hour(Item.End) >= 17) Or (Hour(Item.End) < 8) Then bolSendMsg = True
        End Select
        If bolSendMsg Then
            Set olkMsg = Outlook.Application.CreateItem(olMailItem)
            With olkMsg
                .Recipients.Add "wife@work.com"
                .Recipients.Add "wife@home.com"
                .Recipients.Add "copy@me.com"
                .Recipients.ResolveAll
                .Subject = "After Hours Event Notification - " & Item.Subject
                .HTMLBody = "Hello My Love,<br><br>" _
                    & "I wanted to make you aware of an upcoming appointment on my calendar that's outside of regular working hours. Please let me know if this represents a conflict for anything you had planned. You may find details below:<br><br>" _
                    & "Title: " & Item.Subject & "<br>" _
                    & "Where: " & IIf(Item.Location = "", "Unspecified", Item.Location) & "<br>" _
                    & "Start: " & Item.Start & "<br>" _
                    & "End: " & Item.End & "<br><br>" _
                    & "Notes: <br>" & Item.Body & "<br><br>" _
                    & "Love,<br>" _
                    & "Me"
                .Send
            End With
        End If
    End If
    Set olkMsg = Nothing
End If
 
End Sub

Open in new window

0
David LeeCommented:
The code looks fine.  I took out some blank lines and changed the indents a little to make it more readable.
Public WithEvents olkCalendar As Outlook.Items
 
Private Sub Application_Quit()
    Set olkCalendar = Nothing
End Sub
 
Private Sub Application_Startup()
    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items
End Sub
 
Private Sub olkCalendar_ItemAdd(ByVal Item As Object)
    Dim olkMsg As Outlook.MailItem, bolSendMsg As Boolean
    'Change the category name as desired
    If InStr(1, Item.Subject, "Call ") Then
        Item.Categories = "BUSINESS, Phone Calls"
        Item.Save
    Else
        If InStr(1, Item.Categories, "Family") Or InStr(1, Item.Categories, "NCFPP") Or InStr(1, Item.Categories, "Phone Calls") Then
            'Nothing to do'
        Else
            Item.Categories = "BUSINESS"
            Select Case Weekday(Item.Start)
                Case vbSaturday, vbSunday
                    bolSendMsg = True
                Case Else
                    Select Case Hour(Item.Start)
                        Case 0 To 7
                            bolSendMsg = True
                        Case 17 To 23
                            bolSendMsg = True
                    End Select
                    If (Hour(Item.End) >= 17) Or (Hour(Item.End) < 8) Then bolSendMsg = True
            End Select
            If bolSendMsg Then
                Set olkMsg = Outlook.Application.CreateItem(olMailItem)
                With olkMsg
                    .Recipients.Add "wife@work.com"
                    .Recipients.Add "wife@home.com"
                    .Recipients.Add "copy@me.com"
                    .Recipients.ResolveAll
                    .Subject = "After Hours Event Notification - " & Item.Subject
                    .HTMLBody = "Hello My Love,<br><br>" _
                        & "I wanted to make you aware of an upcoming appointment on my calendar that's outside of regular working hours. Please let me know if this represents a conflict for anything you had planned. You may find details below:<br><br>" _
                        & "Title: " & Item.Subject & "<br>" _
                        & "Where: " & IIf(Item.Location = "", "Unspecified", Item.Location) & "<br>" _
                        & "Start: " & Item.Start & "<br>" _
                        & "End: " & Item.End & "<br><br>" _
                        & "Notes: <br>" & Item.Body & "<br><br>" _
                        & "Love,<br>" _
                        & "Me"
                    .Send
                End With
            End If
        End If
    End If
    Set olkMsg = Nothing
End Sub

Open in new window

0
nss39759Author Commented:
Hey BlueDevilFan,

     Thanks for all your help. This was just the solution I was looking for.

     I'm considering asking another question that demonstrates how to attach the appointment as an .ics or vCalendar file. As i understand it, an .ics file is simply a specially formatted text file. Would it terribly complex to create a text file with the proper format, save it as an .ics file and attach it to the email we're sending from this macro?

     I'm trying to determine whether experts-exchange would be the appropriate venue for this question/

Thanks again for your help.

Regards,
nss39759
0
David LeeCommented:
"how to attach the appointment as an .ics or vCalendar file"
That's simple.  Go ahead and post the question and send me a link or post the link here.
0
David LeeCommented:
Forgot to say that you're welcome and I'm glad I could help.
0
nss39759Author Commented:
Good Day BlueDevil Fan,

I've posted a new question to modify the macro to send the email only on appointments that occur NOW or in the future.

Currently, the macro sends an alert on all appointments that are outside of business hours, including appointment that occurred in the past. I need to modify the logic to fire only when an appointment that is outside of business hours is happening NOW or at some point in the future.

In other words, The macro needs to be modified to only send the alert, when the appointment start date time => (equal to or greater than) NOW {datetime}.

The link is below and I'd be very appreciative if you could participate on this post:

http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_24448487.html

Thanks in advance,
nss39759
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Development

From novice to tech pro — start learning today.