Friday, September 22, 2017

Exporting Your Outlook Calendar to an Excel Spreadsheet Using VBA Macro (2017 Update)

I finally found time to revisit this topic after posting my original article back in 2011.

My skills have much improved and the need for this came up at work so I thought I would have a crack at updating the code and get this out to the people who find value in it.

Back in 2011 I had found and tweaked some VBA code that exports a range of your calendar adding the categories and summing up the time by category.  I used it a lot when I was a Project Manager and Applications Analyst.

Now I'm working at a start-up and there are lots of gaps in reporting. This is where a lot of the old tools I've developed over the years seem to come in handy.

This code is a work in progress and I'll be posting updates along the way.

As of this version.

This is Excel Macro (VBA code) that runs as an Excel Macro which connects to Outlook and extracts calendar items based on a data range the user selects. Returns list of calendar items with the duration of the event in minutes.

I will upload a sample file shortly but the code is updated below. I added update pivot table and pivot chart automatically.

The category part stopped working way back when Outlook 2007 was released so I'll have to see how the code needs to be changed to retrieve categories in the later versions of office. Might add color coding as option as well.

Outlook Calendar Export Version 1.2 Beta

Option Explicit

'Title: Outlook Calendar Export
'Version: 1.2 Beta
'Author: Rick Cable
'Date: 9/22/2017

Sub FindApptsInTimeFrame()
    Dim myStart, myEnd As Date
    Dim Outlook As Outlook.Application
    Dim oCalendar As Outlook.Folder

    Dim oItems As Outlook.Items
    Dim oResItems As Outlook.Items
    Dim oAppt As Outlook.AppointmentItem
    Dim strRestriction As String
    Dim strApptCategories
    ' Set 20 as the number of supported categories, should get that number per user's decision.
    Dim strAllCategories(0 To 20) As String
    Dim iTotalCount As Integer
    Dim iDurationPerCategory(0 To 20) As Integer
    Dim strListSep As String
    Dim i, j, iNumApptCategories
    Dim blnExists As Boolean
    Dim dtDiff As Long
    'Hard-code the reporting dates just for simplicity in testing.
    myStart = InputBox("Start of Range", "Outlook Exporter", Date)
    myStart = CDate(myStart)
    myEnd = InputBox("End of Range", "Outlook Exporter", Date)
    myEnd = CDate(myEnd)
    'Original Code
    'myStart = DateValue("01/14/2013")
    'myEnd = DateValue("01/18/2013")
    Set oCalendar = Session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.Items
    'Include all recurring calendar items -
    'master appointments as well as recurring appointments.
    oItems.IncludeRecurrences = True
    oItems.Sort "[Start]"
    'Specify the filter this way to include appointments that overlap
    'with the specified date range but do not necessarily fall entirely within
    'the date range.
    'Date values in filter do not explicitly include minutes.
    strRestriction = "[Start] <= '" & myEnd _
    & "' AND [End] >= '" & myStart & "'"
    Debug.Print strRestriction
    'Restrict the Items collection.
    Set oResItems = oItems.Restrict(strRestriction)
    oResItems.Sort "[Start]"
    'Disabled by Rick: Reformat myStart and myEnd to account for minutes.
    'myStart = #1/14/2013 12:01:00 AM#
    'myEnd = #1/14/2013 12:01:00 AM#
    iTotalCount = 0
    'Get the separator between categories from the Windows registry.
    strListSep = WSHListSep()
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet
    Worksheets("Outlook Calendar").Activate
    Call DeleteRows
    'Write in the header row
        ActiveCell.Offset(0, 0).Value = "Subject"
        ActiveCell.Offset(0, 1).Value = "Duration"
        ActiveCell.Offset(0, 2).Value = "Appointment Start"
        ActiveCell.Offset(1, 0).Select
    For Each oAppt In oResItems
        ActiveCell.Offset(0, 0).Value = oAppt.Subject
        ActiveCell.Offset(0, 1).Value = oAppt.Duration
        ActiveCell.Offset(0, 2).Value = oAppt.Start
        Debug.Print oAppt.Start, oAppt.Subject
        Debug.Print oAppt.Duration
        ' Get the list of categories specified for this appointment.
        strApptCategories = Split(oAppt.Categories, strListSep)
        iNumApptCategories = UBound(strApptCategories)
        ' An appointment that doesn't have a category (with iNumApptCategories being 0) skips this loop.
        For i = 0 To iNumApptCategories
            ' Check if category exists in master array strAllCategories.
            blnExists = False
            If iTotalCount > 0 Then
                ' Master array already has some categories, see if there's a match or should add category
                For j = 0 To iTotalCount - 1
                    If Trim(strAllCategories(j)) = Trim(strApptCategories(i)) Then
                        blnExists = True
                        Exit For
                    End If
                If blnExists = False Then
                    ' First time this category appears, add category to master array and start tallying time.
                    If iTotalCount >= 20 Then
                        MsgBox "The maximum number of categories has been reached."
                        GoTo Dump
                    End If
                    iTotalCount = iTotalCount + 1
                    strAllCategories(iTotalCount - 1) = Trim(strApptCategories(i))
                    ' Check if the appointment is entirely within the date range.
                    If oAppt.Start >= myStart Then
                        If oAppt.End <= myEnd Then
                            iDurationPerCategory(iTotalCount - 1) = oAppt.Duration
                            dtDiff = DateDiff("n", myEnd, oAppt.End)
                            iDurationPerCategory(iTotalCount - 1) = oAppt.Duration - dtDiff
                        End If
                        dtDiff = DateDiff("n", oAppt.Start, myStart)
                        iDurationPerCategory(iTotalCount - 1) = oAppt.Duration - dtDiff
                    End If
                    ' Category already in master array, just tally the time for the category.
                    ' Check if the appointment is entirely within the date range.
                    If oAppt.Start >= myStart Then
                        If oAppt.End <= myEnd Then
                            iDurationPerCategory(j) = iDurationPerCategory(j) + oAppt.Duration
                            dtDiff = DateDiff("n", myEnd, oAppt.End)
                            iDurationPerCategory(j) = iDurationPerCategory(j) + oAppt.Duration - dtDiff
                        End If
                        dtDiff = DateDiff("n", oAppt.Start, myStart)
                        iDurationPerCategory(j) = iDurationPerCategory(j) + oAppt.Duration - dtDiff
                    End If
                End If
                ' First category in master array of categories, start master array and start count of categories.
                iTotalCount = 1
                strAllCategories(0) = Trim(strApptCategories(i))
                ' Check if the appointment is entirely within the date range.
                If oAppt.Start >= myStart Then
                    If oAppt.End <= myEnd Then
                        iDurationPerCategory(0) = oAppt.Duration
                        dtDiff = DateDiff("n", myEnd, oAppt.End)
                        iDurationPerCategory(0) = oAppt.Duration - dtDiff
                    End If
                    dtDiff = DateDiff("n", oAppt.Start, myStart)
                    iDurationPerCategory(0) = oAppt.Duration - dtDiff
                End If
            End If
        ActiveCell.Offset(1, 0).Select
    Dim Sheet As Worksheet
    Dim Pivot As Excel.PivotTable
    'Refresh the Pivot table with updated data
    For Each Sheet In ThisWorkbook.Worksheets
        For Each Pivot In Sheet.PivotTables
    'List all unique categories and count
    For j = 0 To iTotalCount - 1
        MsgBox (strAllCategories(j) & " = " & (iDurationPerCategory(j) / 60) & " hours")
        Debug.Print strAllCategories(j), iDurationPerCategory(j)
End Sub

Function WSHListSep()
    Dim objWSHShell
    Dim strReg
    strReg = "HKCU\Control Panel\International\sList"
    Set objWSHShell = CreateObject("WScript.Shell")
    WSHListSep = objWSHShell.RegRead(strReg)
    Set objWSHShell = Nothing
End Function

Sub DeleteRows()
Application.ScreenUpdating = False
Sheets("Outlook Calendar").Range("A2:C5000").Delete Shift:=xlUp
Application.ScreenUpdating = True
End Sub

Monday, September 18, 2017

Excel Pivot Chart Won't Update with New Data

I had found myself stuck today while working on an Excel Pivot Table and Pivot Chart.

I had made a copy of some source data that I was using for a set of pivot charts.

I decided and needed a subset of that data with duplicates removed and I would create another pivot table and chart based on this new subset of data.

When I create a new pivot table it was still showing me data from the previous data set.

Thanks to the article below, I solved my issue.

Here is the fix.

Go to > PivotTable Options > Data >

Number of Items to retain per Field > None >


Thursday, September 14, 2017

Salesforce Administrator Trailhead - Quote Template Setup not Showing after Quote Templates Enabled

This is a very short tip for anyone working on the Salesforce Administrator Trailhead training modules.

I was working on Quotes and Quote settings when I discovered a problem.

The trailhead tells you to enable quotes from the setup menu then create new quote template.

 Guess what, they aren't there.... WTF!

OK, so do this before you pull all your hair out.

LOG OUT of your Salesforce Trailhead then log right back in.

For whatever reason, you must log out of Saleforce after enabling Quotes, then log back in to see them enabled.

Fun stuff. Hope this helps some other poor soul.

Good luck.


Friday, September 1, 2017

An Entertaining Look at the New Tech Start-Up Bubble from Dan Lyons (Hubspot and Beyond)

Happy Friday!

I'm in my cube waiting for my Redbull to kick in and thought I would share an entertaining and educational video I found this morning.

Dan Lyons used to be a writer for Newsweek.  After being laid off and 52, he wanted to work at a start-up to see what it was like.  He landed a job at a Boston area tech start-up called HubSpot.

Dan details his experiences there and elaborates on why so many tech start-ups are failing.

I will +1 Dan on this and say is it all about culture. If  you're culture is BS, then you're company is BS.

Enjoy the video.


Thursday, August 31, 2017

What Programming Schenanigans is Rick Up to in August 2017?

This is my August 2017 "Programming Schenanigans" update.

As I can't really talk about my day job much, even though I would love to talk about some of the challenges we face on a daily basis, I will say it has been an amazing 8 months thus far in my new developer role.

I left an engineering support role to help develop resilient technical teams to develop and support some new products.  I took the role knowing it would be chaos but building new teams to do very special work in one of the most challenging domains in IT was a challenge I eagerly accepted. I do love a challenge.

I felt my 20+ year experience at prototyping and attempting startups has come in very handy. I am truly a "Jack of all Trades" IT guy.

In between the multiple projects and taking the Admin Course (still in it), I managed to find a little spare time to get in some upgrades to my life's work,

Upgrade included:

  • HTML and CSS upgrades. Improved experience on Tablet devices.
  • Implementing HTTPS - sites users can now have a secure way to post data.
  • Hardening systems that help the blocking of "Bad Guys"
  • Setup new advertising campaigns to drive more traffic to site
  • Since I've been getting some good traffic and posting from this area lately, I added a new Metro Area for Nashua, New Hampshire. This means site configuration for a new Metro Area and adding DNS entries for the cononical name, then adding the binding in IIS.

Wednesday, August 30, 2017

How to Code the Old ASCII XMas Tree in C# - Repost from my Really Old Blog at

This is a re-post from my very first tech blog post back in 2009 when I was taking programming courses at MJC. This is a classic class project that some may struggle with so here is my very old article on how to code a ASCII XMas Tress in C#.

Introduction to C# Programming: ASCII Xmas Tree - C# and .Net Sample Project

C#, pronounced C Sharp, is a relatively new programming language from Microsoft that was designed to take full advantage of the new .Net Framework.
Below is a sample project I did for a programming class I'm attending at MJC in Modesto. To test and run the code listed on this site you should download a free copy of Microsoft Visual C# Express 2005. There are four Visual Studio Express versions available for free from Microsoft, Visual Basic, C#, J# and C++.
The xmas tree project was a good idea. It really makes you think. I think this project could have been a little more fun for me if I had a little more time but my schedule just won't allow it. I don't see myself coming back to often to update this code but if others want to sent me some other samples I may post them later. So here it goes....
Last updated: Monday, December 4, 2006 8:00 PM

Screen Shot

This is what the final result should look like.

The Code

The purpose of this project as I understood it was to write a console program using C#. The goal is to draw a Christmas tree on the screen by making use of arrays and nested for loops. Of course, the one time I missed class all year and that was the day the instructor was discussing this new project. Luckily a fellow student took the time to go over it with me and this is what I came up with. Not sure if it is exactly correct but I'm sure it is close.
Download a copy of tree.exe, the executable file. You can run the code right from here by clicking on it or right click and choose save link as...
using System;

using System.Collections.Generic;

using System.Text;

namespace ConsoleApplication1

    class Program


        static void Main(string[] args)


            //create the main array

            int[] myArray = new int[] { 1, 3, 5, 7, 9 };
            //The outside foreach loop to loop throught the array

            foreach (int intLoop in myArray)


                //creates the spaces, takes the array number minus 1 then divide by 2

                //this gives you the amount of spaces needed for each level of the tree

                 for (int iSpace = 0; iSpace < ((myArray[4]-intLoop)/2); iSpace++)


                    System.Console.Write(" ");


                //middle loop writes the asterisks "*" the full amount of current array[]

                for (int i = 0;i < intLoop; i++)




                //creates the spaces, takes the array number minus 1 then divide by 2

                //this gives you the amount of spaces needed for each level of the tree

              for (int iSpace = 0; iSpace < ((myArray[4] - intLoop) / 2); iSpace++)


                 System.Console.Write(" ");


            //creates new lines after all 3 loops run



            //nest this loop and do it 3 times

            for (int iBase = 0; iBase < myArray[1]; iBase++)


                // now make the base of the tree

                for (int iSpaces = 0; iSpaces < myArray[1]; iSpaces++)


                    System.Console.Write(" ");


                for (int iPipes = 0; iPipes < myArray[1]; iPipes++)




                // now make the base of the tree

                for (int iSpaces = 0; iSpaces < myArray[1]; iSpaces++)


                    System.Console.Write(" ");


                  //creates new lines after all 3 loops run





VBScript: Adding Leading Zeros to a Date - A Repost from my really old blog at

VBScript: Adding Leading Zeros to a Date

This is a re-post from my really old blog at  I thought that there is still some value for this old code for someone so here it is. Hopefully it indexes better here than on my old site. There is no value in this code if nobody can find it.

I was recently developing a script to loop through an excel file and write the contents in to a text file.  One of the specifications was that the output dates had to have leading zeros like 01/01/2011 but the excel file had them as 1/1/2011.

I thought there must a VBScript function like the built in CDate for or FormatDateTime but neither of these seemed to return dates with leading zeros so I wrote my own function to do it.

As in all programing, there are many ways to write this to get the same output but this way worked for me on the project I used it for.  

Function FixDate(strDate)
Dim iTemp, arrDate, item, strTemp

 ' my custom date fix function
 ' split the date in to an array by the "/" character
 ' check each date item and check to see if it is less than 1000
 arrDate = Split(strDate,"/")
 for each item in arrDate
  if len(item) < 2 then
   item = "0" & item
  end if
  ' Next section makes sure there is no / at the end of the rebuilt date when I put it back together.
  if item < 100 then
   strTemp = strTemp & item & "/"
   strTemp = strTemp & item
  end if
 ' Put the date back together
 FixDate = strTemp
End Function



Friday, August 18, 2017

When to Use Angular and when to use React frameworks?

I was listening to the Software Engineering Daily podcast recently and I had found great value in Developer, Kyle Mathew's detailed and well thought out perspective on the differences between Angular and React Javascript frameworks.

I found it enlightening since I'm relatively new to these topic but extremely interested.

Click and enjoy!  

Thursday, July 20, 2017

Excel Pivot Chart Data Label Bug - Display 00 days as 30

This is a place holder for me to come back and talk about a bug that I discovered in Excel 2013 while working on a analytic / dashboard prototype solution for my day job.

When using Pivot Charts and using data formatted as dd:hh:mm. Data labels are showing 00 days as 30.

Pretty sure this ties back to the default date or first date value in VB Date object / array as being 12/30/1899.

The expect return value should The value being returns for day values of 00 is 30.

Example: dd:hh:mm = 00:08:12

Bug: dd:hh:mm = 30:08:12 (Day portion return 30 for day = 0 / 0 in date array dd = 30)

I am pretty sure the "30" being returned instead of expected value of  "00" by the Pivot chart is from the 0 position of the VB Date object array.

UPDATE: 8/18/2017

The issue is extracting integer numbers so we can do math to them.

I'll be coming back to post the solution from the code I ended up with after I clean it up for the public.

Saturday, April 15, 2017

Excel VBA: Find Next Empty Cell in Row, When only Row 1 is Populated

It is Saturday and I'm about to go out and mow my lawn but I had an Excel VBA problem I wanted to get past fist.

Not sure this is the best solution, but it is the one I came up with so I'll share it with you now before I go mow.

Problem: Have worksheet that is an event log for other subroutines. When created, the worksheet had a header row also created with data in Row 1 across columns A thru G.

When "WriteToEventLog" call is firing off, we're checking for next empty row in column A and cell "A1" already has header data written to it.

The method below works when cell "A2" is the starting cell, but fails when cell "A1" is used as the starting Range.

This code fails in an infinite loop and Out of Memory Error when starting from cell "A1" and ends up selecting all the cells memory can hold from column A.

        ActiveCell.Offset(1, 0).Select

Here is my Saturday morning, pre mow, attempt to solve this issue with a custom Excel VBA function that correctly finds the next empty cell when row 1 contains the header row.

Please email me if you read this and it has helped you in any way.

1st Pass Code:

Sub AddItemToEndOfList()
    'We assume that row 1 is already filled out from first process
    'Check to see if cell A2 is empty, if so then enter the next value in A2.
    'if not then go to next empty cell and enter the value.
    If IsEmpty(Range("A2").Value) Then
        ActiveCell.Value = ""
        ActiveCell.Offset(1, 0).Select
        ActiveCell.Value = ""
    End If
End Sub

This can all be replaced with one line of code...

2nd Pass Code:

Range("A2").End(xlDown).End(xlUp).Offset(1, 0).Select

This works every time when we know Row 1 is already populated.