Add Logic That Invokes Outlook Macro For Future Events

A macro was written to send an " alert " email anytime an appointment was added to the Outlook Calendar AND is outside of normal business hours.

The macro works perfectly, but fires on any new appointment that is added to the Outlook calendar. This includes appointments that occurred in the past.

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

A copy of the original macro has been included below:

Thanks in advance,
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

nss39759Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
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.

Replace the olkCalendar_ItemAdd subroutine with the one below.
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
            If Item.Start > Now Then
                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 If
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:
Good Day Blue Devil Fan,

So, I should just simply add the statement,

"If Item.Start > Now Then" and close it with 'End If"

Why not,

"If Item.Start => Now Then" ?

Regards,
nss39759
0
David LeeCommented:
Yes, that's the only change.  You change the test from greater than to greater than or equal to.  
0
Patrick MatthewsCommented:
0
David LeeCommented:
Hi, Patrick.

I'll have a look.
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.