Send me an email of my Outlook (2007) calendar schedule for the next day

epuglise
epuglise used Ask the Experts™
on
I searched the knowledge base and found nearly what I need:
http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_24185431.html?sfQueryTermInfo=1+10+30+calendar+daili+email+my+outlook

I am not familiar at all with any of these Outlook functions.  I need to alter the attached code (originally from BlueDevilFan) so that it does the following:

1. Right now the email it sends gives me the start and end time of the appointment in MILITARY time (I hate that) and the title of the appointment.
2. I can't tell which day the appointment is actually on, since I only get the start and end time.
3. It looks to include appointments from the previous week as well as some from the future, so including the date should help me figure out why it is NOT giving me ONLY the appointments for the next day.

Please, Experts, help me fix the code so it sends me:
1. Just my appointments for the next day
2. (at a minimum) The appointment date, start time (in 12-hour format) and subject of the appointment
3. a method for triggering the code to run at a particular time each day.

Alternatively, if there is an on-board Outlook macro or function that will _automatically_ send me the next day's calendar events via the Outlook "Send a Calendar via E-mail" (limited details version) function. (I would actually like this better since I really like the layout of the email that gets generated...)

Thanks!
Const olFolderCalendar = 9
Const olMailItem = 0
Const olFormatHTML = 2
Dim olkApp, olkSes, olkCalendar, olkToday, olkItem, olkMsg, strStart, strEnd, strAgenda, intIndex
strStart = Month(Date) & "/" & Day(Date) & "/" & Year(Date) & " 12:01 AM"
strEnd = Month(Date) & "/" & Day(Date) & "/" & Year(Date) & " 11:59 PM"
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
'Change the profile name on the next line as needed'
olkSes.Logon "Outlook"
Set olkCalendar = olkSes.GetDefaultFolder(olFolderCalendar)
olkCalendar.Items.Sort "Start", False
olkCalendar.Items.IncludeRecurrences = True
Set olkToday = olkCalendar.Items.Restrict("[Start] >= '" & strStart & "' AND [Start] <= '" & strEnd & "'")
strAgenda = "<table><tr><td width=""15%"" align=""right"">Start</td><td wisth=""15%"" align=""right"">End</td><td width=""50%"">Subject</td><td width=""20%"">Location</td></tr>"
For intIndex = olkToday.Count to 1 Step -1
    Set olkItem = olkToday.Item(intIndex)
    With olkItem
        If (Not .AllDayEvent) Or (.AllDayEvent And .Start = Date) Then
            strAgenda = strAgenda & "<tr><td align=""right"">" & FormatDateTime(.Start, 4) & "</td>" _
                & "<td align=""right"">" & FormatDateTime(.End, 4) & "</td>" _
                & "<td>" & .Subject & "</td>" _
                & "<td>" & .Location & "</td></tr>"
        End If
    End With
Next
strAgenda = strAgenda & "</table>"
Set olkMsg = olkApp.CreateItem(olMailItem)
With olkMsg
    .BodyFormat = olFormatHTML
    'Change the email address on the next line'
    .Recipients.Add "someone@company.com"
    .Subject = "Today's Agenda"
    .HTMLBody = strAgenda
    .Send
End With
Set olkMsg = Nothing
Set olkItem = Nothing
Set olkToday = Nothing
Set olkCalendar = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2010

Commented:
Hi, epuglise.

Try this.  This should take care of items 1 and 2.  For item 3 use Windows built-in task scheduler.
Const olFolderCalendar = 9
Const olMailItem = 0
Const olFormatHTML = 2
Dim olkApp, olkSes, olkCalendar, olkToday, olkItem, olkMsg, strStart, strEnd, strAgenda, intIndex, datTomorrow
datTomorrow = Date() + 1
strStart = Month(datTomorrow) & "/" & Day(datTomorrow) & "/" & Year(datTomorrow) & " 12:01 AM"
strEnd = Month(datTomorrow) & "/" & Day(datTomorrow) & "/" & Year(datTomorrow) & " 11:59 PM"
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
'Change the profile name on the next line as needed'
olkSes.Logon "Outlook"
Set olkCalendar = olkSes.GetDefaultFolder(olFolderCalendar)
olkCalendar.Items.Sort "Start", False
olkCalendar.Items.IncludeRecurrences = True
Set olkToday = olkCalendar.Items.Restrict("[Start] >= '" & strStart & "' AND [Start] <= '" & strEnd & "'")
strAgenda = "<table><tr><td width=""20%"" align=""left"">Start</td><td wisth=""20%"" align=""left"">End</td><td width=""40%"">Subject</td><td width=""20%"">Location</td></tr>"
For intIndex = olkToday.Count to 1 Step -1
    Set olkItem = olkToday.Item(intIndex)
    With olkItem
        If (Not .AllDayEvent) Or (.AllDayEvent And .Start = Date) Then
            strAgenda = strAgenda & "<tr><td align=""left"">" & FormatDateTime(.Start, 0) & "</td>" _
                & "<td align=""left"">" & FormatDateTime(.End, 0) & "</td>" _
                & "<td>" & .Subject & "</td>" _
                & "<td>" & .Location & "</td></tr>"
        End If
    End With
Next
strAgenda = strAgenda & "</table>"
Set olkMsg = olkApp.CreateItem(olMailItem)
With olkMsg
    .BodyFormat = olFormatHTML
    'Change the email address on the next line'
    .Recipients.Add "someone@company.com"
    .Subject = "Today's Agenda"
    .HTMLBody = strAgenda
    .Send
End With
Set olkMsg = Nothing
Set olkItem = Nothing
Set olkToday = Nothing
Set olkCalendar = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing

Open in new window

Author

Commented:
Wow. The layout and information in this version is way better!  The only problem is that for recurring meetings, it doesn't put the actual (upcoming date) and these aren't all just "tomorrow's" (or even today's) meetings.

Here's the output (I edited out the personal info) I got in an email after running the code. The One-time meeting is fine. The locations are all ok. But my recurring meetings aren't showing up correctly.  Is there a different field to use for those?

Start                  End                  Subject                  Location
8/9/2011 8:00:00 AM      8/9/2011 8:30:00 AM      One Time meeting A      Location (OK)
1/3/2011 1:00:00 PM      1/3/2011 2:00:00 PM      Recurring meeting A      Location (OK)
6/9/2011 11:00:00 AM      6/9/2011 12:00:00 PM      Canceled: meeting A      Location (OK)
6/1/2011 8:30:00 AM      6/1/2011 9:00:00 AM      Recurring meeting B      Location (OK)    
5/30/2011 5:30:00 AM      5/30/2011 5:30:00 AM      recurring meeting C       Location (OK)      
4/25/2011 12:00:00 PM      4/25/2011 1:00:00 PM      Recurring Meeting D     Location (OK)
3/9/2011 12:00:00 PM      3/9/2011 1:00:00 PM      Recurring Meeting E      Location (OK)
2/24/2011 11:30:00 AM      2/24/2011 12:00:00 PM      Recurring Meeting F      Location (OK)
2/17/2011 11:00:00 AM      2/17/2011 12:00:00 PM      Recurring Meeting G      Location (OK)

Thanks so much for your help with this.
Top Expert 2010
Commented:
That's what I get for assuming that the code just needed a minor modification.  Sorry about that.  Try this version.
Const olFolderCalendar = 9
Const olMailItem = 0
Const olAscending = 1
Const olFormatHTML = 2
Dim olkApp, olkSes, olkCalendar, olkToday, olkItem, olkMsg, strStart, strEnd, strAgenda, intIndex, datTomorrow
datTomorrow = DateAdd("d", 1, Date)
strStart = Month(datTomorrow) & "/" & Day(datTomorrow) & "/" & Year(datTomorrow) & " 0:01 AM"
strEnd = Month(datTomorrow) & "/" & Day(datTomorrow) & "/" & Year(datTomorrow) & " 11:59 PM"
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
'Change the profile name on the next line as needed'
olkSes.Logon "Outlook"
Set olkCalendar = olkSes.GetDefaultFolder(olFolderCalendar).Items
With olkCalendar
    .IncludeRecurrences = True
    .Sort "Start"
End With
Set olkToday = olkCalendar.Restrict("[Start] >= '" & strStart & "' AND [Start] <= '" & strEnd & "'")
strAgenda = "<table><tr><td width=""20%"" align=""left"">Start</td><td wisth=""20%"" align=""left"">End</td><td width=""40%"">Subject</td><td width=""20%"">Location</td></tr>"
For Each olkItem In olkToday
    With olkItem
        If (Not .AllDayEvent) Or (.AllDayEvent And .Start = datTomorrow) Then
            strAgenda = strAgenda & "<tr><td align=""left"">" & FormatDateTime(.Start, 0) & "</td>" _
                & "<td align=""left"">" & FormatDateTime(.End, 0) & "</td>" _
                & "<td>" & .Subject & "</td>" _
                & "<td>" & .Location & "</td></tr>"
        End If
    End With
Next
strAgenda = strAgenda & "</table>"
Set olkMsg = olkApp.CreateItem(olMailItem)
With olkMsg
    .BodyFormat = olFormatHTML
    'Change the email address on the next line'
    .Recipients.Add "someone@company.com"
    .Subject = "Today's Agenda"
    .HTMLBody = strAgenda
    .Send
End With
Set olkMsg = Nothing
Set olkItem = Nothing
Set olkToday = Nothing
Set olkCalendar = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing

Open in new window

Author

Commented:
Yep that works!! All of tomorrow's stuff, nicely laid out.

Thanks!!!

Author

Commented:
I've requested that this question be closed as follows:

Accepted answer: 0 points for epuglise's comment http:/Q_27243021.html#36334982

for the following reason:

This is a great piece of code to do something Outlook should be able to do.

Author

Commented:
PS For future users: don't forget when you change the email address of the recipient to also change the subject of the email-- it should say "TOMORROW's Agenda" :)
Top Expert 2010
Commented:
epuglise,

You selected to close the question by accepting one of your comments as the answer and not awarding any points.  I assume that's a mistake.  If so, then you can cancel the pending close and go back through the close process again.

Author

Commented:
that is very strange because I clicked on the Accept as Solution on your code , graded everything "A" and provided a comment. I have no idea what this orange triangle is about but it looks like i have to contact an admin to fix it.

Author

Commented:
I have no idea what happened... I would like to Accept BlueDevil's last piece of code as the solution and award all points to him. Please advise...

Author

Commented:
That supposed comment above from me with the hyperlink and zero points awarded was generated after I tried to award the points to your code. Something is messed up. I've assigned points lots of times... and have never screwed things up like this before LOL!
Top Expert 2010

Commented:
No worries.
Jarrad KoppenBusiness Solutions

Commented:
Hi

Would it possible to get this code updated to work within Outlook 2013 ?

Regards

Jarrad
Top Expert 2010

Commented:
Hi, Jarrad.

The code should work just fine in Outlook 2013.  That's the version I'm using and it works for me.  If it's not working for you, then can you give me any additional details such as an error message?

The above aside, while I was looking the code over I noticed that it needs a couple of changes.  These aren't Outlook 2013 specific issues, just some minor tweaks.

Const olFolderCalendar = 9
Const olMailItem = 0
Const olAscending = 1
Const olFormatHTML = 2
Dim olkApp, olkSes, olkCalendar, olkToday, olkItem, olkMsg, strStart, strEnd, strAgenda, intIndex, datTomorrow, strQry
datTomorrow = DateAdd("d", 1, Date)
strStart = datTomorrow & " 12:00 AM"
strEnd = datTomorrow & " 11:59 PM"
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
'Change the profile name on the next line as needed'
olkSes.Logon olkApp.DefaultProfileName
Set olkCalendar = olkSes.GetDefaultFolder(olFolderCalendar).Items
With olkCalendar
    .Sort "[Start]"
    .IncludeRecurrences = True
End With
strQry = "[Start] >= '" & strStart & "' AND [End] <= '" & strEnd & "'"
Set olkToday = olkCalendar.Restrict(strQry)
strAgenda = "<table><tr><td width=""20%"" align=""left"">Start</td><td wisth=""20%"" align=""left"">End</td><td width=""40%"">Subject</td><td width=""20%"">Location</td></tr>"
For Each olkItem In olkToday
    With olkItem
        If Not .AllDayEvent Then
            strAgenda = strAgenda & "<tr><td align=""left"">" & FormatDateTime(.Start, 3) & "</td>" _
                & "<td align=""left"">" & FormatDateTime(.End, 3) & "</td>" _
                & "<td>" & .Subject & "</td>" _
                & "<td>" & .Location & "</td></tr>"
        End If
    End With
Next
strAgenda = strAgenda & "</table>"
Set olkMsg = olkApp.CreateItem(olMailItem)
With olkMsg
    .BodyFormat = olFormatHTML
    'Change the email address on the next line'
    .Recipients.Add "someone@company.com"
    .Subject = "Today's Agenda"
    .HTMLBody = strAgenda
    .Display
End With
Set olkMsg = Nothing
Set olkItem = Nothing
Set olkToday = Nothing
Set olkCalendar = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing

Open in new window

Jarrad KoppenBusiness Solutions

Commented:
Hi BlueDevilFan

Perhaps it is how I've installed the macro. Not sure!!

I've attached the error with a screenshot

Regards

Jarrad
2014-07-03-21h00-13.png
Top Expert 2010

Commented:
Jarrad,

That code isn't designed to be run from inside Outlook.  It's designed to run outside of Outlook. Here's how to use it

1.  Open Notepad
2.  Copy the code and paste it into Notepad
3.  Edit the code per the comments I included in it.  Comment lines begin with an apostrophe.
4.  Save the file.  You can name it anything you want, the file extension must be .vbs
5.  Double-click the file to run it.

The reason this script runs outside of Outlook is so you can use Windows Task Scheduler to run it at some set time each day.
Jarrad KoppenBusiness Solutions

Commented:
Arhh I see my error. Thank you for clearing that up!!
Top Expert 2010

Commented:
You're welcome.
Jarrad KoppenBusiness Solutions

Commented:
Hi Everyone

FYI... the latest code requires that line 39 reads ".send" rather then ".display", if you are running it on an automatic schedule.

Jarrad

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial