Count the number of scheduling each appointment

I would like to know how many times I re-schedule an appointment. I use Microsoft Outlook, and many times I have to postpone meetings, I would like to count the number of these postponements.
To achieve that goal, I would like to build a macro that runs through all my "Sent" items, get all the appointments that I've scheduled. Then, create an excel file that contains for each appointment these details: Organizer, Subject, Sent time, Start time, Location, Require Attendees, Optional Attendees, Attendee Response (If possible?). Later on I could analyze that report.
Could anyone help me - What is the best way to do so? I am a programmer but not familiar very well with office macro's syntax. I have found some similar codes online, but couldn't make it work on office 2010+2013.
Thank you all! :-)

The Sent folder varies depending on if on Exchange or not. I commented the default way but used the more elaborate method to set the folder for an account.

Run Main() with a blank sheet active. Some property values are limited to just the item in your Sent folder. e.g. ResponseStatus which is just for your response.

First off, here is the Main() routine. The 2nd code block shows how to get the string for your Sent folder or any Outlook folder. Be sure to add the Outlook reference as I commented.

Code:

Sub Main() Dim a, b 'Early Binding: Tools > References > Microsoft Outlook xx.0 Object Library > OK Dim oApp As Outlook.Application Dim oG As Outlook.Folder 'Method for IMAP, as used by Gmail. Dim oM As Outlook.MeetingItem, oAA As Outlook.AppointmentItem Dim sMsg$, sAdd$, i As Long, j As Long 'Late Binding: 'Dim oApp As Object, oG As Object Set oApp = CreateObject("Outlook.Application") 'Set oG = oNS.GetDefaultFolder(5) 'olFolderSentMail=5 'Set oG = GetFolderPath("\\ken@gmail.com\[Gmail]\Sent Mail", oApp) Set oG = GetFolderPath("\\ken@school.edu\Sent Items", oApp) For i = 1 To oG.Items.Count 'Debug.Print i, TypeName(oG.Items(i)) If TypeName(oG.Items(i)) = "MeetingItem" Then j = j + 1 Next i If j = 0 Then Exit Sub ReDim a(1 To j, 1 To 8) On Error Resume Next j = 0 For i = 1 To oG.Items.Count If TypeName(oG.Items(i)) = "MeetingItem" Then 'Set oM = oG.Items(i) 'Let's you use itellisense whereas oG.Items(i) does not. 'Set oAA = oG.Items(i).GetAssociatedAppointment(False) 'With oAA With oG.Items(i).GetAssociatedAppointment(False) j = j + 1 a(j, 1) = .Organizer 'Could error if no orgnaizer a(j, 2) = .Subject 'a(j, 3) = oM.ReceivedTime a(j, 3) = .CreationTime a(j, 4) = .Start a(j, 5) = .Location a(j, 6) = .RequiredAttendees a(j, 7) = .OptionalAttendees 'https://docs.microsoft.com/en-us/office/vba/api/outlook.olresponsestatus a(j, 8) = .ResponseStatus End With End If Next i On Error GoTo 0 'Title in row 1. b = Split("Oraganizer,Subject,CreationTime,Start,Location,RequiredAddttendees,OptionalAttendees,ResponseStatus", ",") [A1].Resize(, UBound(b) + 1) = b 'Data from Outlook Sent folder's MeetingItem properties. 'Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(a), UBound(a, 2)).Value = a [A2].Resize(UBound(a), UBound(a, 2)).Value = a ActiveSheet.UsedRange.EntireColumn.AutoFit [A1].Select End Sub

If you use the Default folder, you won't need this. The first routine let's you pick an Outlook folder to get the string for the 2nd function that was called in Main().

Code:

'Get the FolderPath string to pass to GetFolderPath(). Sub GetFolder() Dim olApp As Outlook.Application Dim olNS As Outlook.Namespace Dim olFolder As Outlook.MAPIFolder Set olApp = Outlook.Application Set olNS = olApp.GetNamespace("MAPI") Set olFolder = olNS.PickFolder Debug.Print olFolder.FolderPath MsgBox olFolder.FolderPath End Sub 'IMAP, folder path, https://www.slipstick.com/outlook/outlook-2013-imap-folder/ 'Similar to, http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/#GetFolderPath ''Early Binding: Tools > References > Microsoft Outlook xx.0 Object Library > OK Function GetFolderPath(ByVal FolderPath As String, oApp As Outlook.Application) As Outlook.Folder Dim oFolder As Outlook.Folder Dim FoldersArray As Variant Dim i As Integer On Error GoTo GetFolderPath_Error If Left(FolderPath, 2) = "\\" Then FolderPath = Right(FolderPath, Len(FolderPath) - 2) End If 'Convert folderpath to array FoldersArray = Split(FolderPath, "\") 'Set oFolder = Application.Session.Folders.Item(FoldersArray(0)) Set oFolder = oApp.Session.Folders.Item(FoldersArray(0)) If Not oFolder Is Nothing Then For i = 1 To UBound(FoldersArray, 1) Dim SubFolders As Outlook.Folders Set SubFolders = oFolder.Folders Set oFolder = SubFolders.Item(FoldersArray(i)) If oFolder Is Nothing Then Set GetFolderPath = Nothing End If Next End If 'Return the oFolder Set GetFolderPath = oFolder Exit Function GetFolderPath_Error: Set GetFolderPath = Nothing Exit Function End Function

Quote:

Originally Posted by Kenneth Hobs

The Sent folder varies depending on if on Exchange or not. I commented the default way but used the more elaborate method to set the folder for an account.

Run Main() with a blank sheet active. Some property values are limited to just the item in your Sent folder. e.g. ResponseStatus which is just for your response.

First off, here is the Main() routine. The 2nd code block shows how to get the string for your Sent folder or any Outlook folder. Be sure to add the Outlook reference as I commented...

Wow! You're the best! Thank you very much!!! :)
I've read the code and run it, and it works perfectly :)
However I have 2 questions about it:

The "Start" parameter displays for each postponed appointment the current start time of the appointment, instead of the start time that was set originally when that appointment was sent ("When" parameter).
For example, if I set an appointment to 01/01/2019 and then postpone it to 02/01/2019 - In the report, in both lines of that appointment, the "Start" cell displays "02/01/2019", instead of "01/01/2019" and "02/01/2019". I've looked over Microsoft documentary, and tried to find that object on my own, but couldn't find the correct one. Is there any way to get the information of "When" parameter?
Is there any way to display a list of the attendees response for each appointment that I sent? Maybe by getting that info from another folder in Outlook (perhaps Inbox)? So later on I could cross that information with the current report).

Thank you

There are three objects that I defined so you could easily use Intellisense to find the methods and properties. Those were oG, oM, and oAA. Just type those objects in the routine and a period to see the methods and properties.

Here is an example that shows when the email was sent. The first uses intellisense providing that the object was Set earlier. The 2nd part shows the same but no Intellisense.

Code:

Debug.Print oM.SentOn, oG.Items(i).SentOn

Debug.Print simply puts the results in the VBE Immediate Window during the run.

For (2), one way would be to save the response from each. Consider making a folder and apply an Outlook rule that moves them from InBox folder to your made calendar response folder. You would then get the ResponseStatus value in a macro.

I am not sure what you mean in (1). If a start time was changed, there would be no record of what original start time was after the change.

I forgot to set the Set object to Nothing in Main(). Normally, that is not needed but for this, you should add those. Normally, one sets those to Nothing in reverse order of creation. e.g.

Code:

Sub Main() Dim a, b 'Early Binding: Tools > References > Microsoft Outlook xx.0 Object Library > OK Dim oApp As Outlook.Application Dim oG As Outlook.Folder 'Method for IMAP, as used by Gmail. Dim oM As Outlook.MeetingItem, oAA As Outlook.AppointmentItem Dim sMsg$, sAdd$, i As Long, j As Long 'Late Binding: 'Dim oApp As Object, oG As Object Set oApp = CreateObject("Outlook.Application") 'Set oG = oNS.GetDefaultFolder(5) 'olFolderSentMail=5 'Set oG = GetFolderPath("\\ken@gmail.com\[Gmail]\Sent Mail", oApp) Set oG = GetFolderPath("\\ken@school.edu\Sent Items", oApp) For i = 1 To oG.Items.Count 'Debug.Print i, TypeName(oG.Items(i)) If TypeName(oG.Items(i)) = "MeetingItem" Then j = j + 1 Next i If j = 0 Then Exit Sub ReDim a(1 To j, 1 To 8) On Error Resume Next j = 0 For i = 1 To oG.Items.Count If TypeName(oG.Items(i)) = "MeetingItem" Then 'Set oM = oG.Items(i) 'Let's you use itellisense whereas oG.Items(i) does not. 'Set oAA = oG.Items(i).GetAssociatedAppointment(False) 'With oAA With oG.Items(i).GetAssociatedAppointment(False) j = j + 1 a(j, 1) = .Organizer 'Could error if no orgnaizer a(j, 2) = .Subject 'a(j, 3) = oM.ReceivedTime 'Debug.Print oM.SentOn, oG.Items(i).SentOn a(j, 3) = .CreationTime a(j, 4) = .Start a(j, 5) = .Location a(j, 6) = .RequiredAttendees a(j, 7) = .OptionalAttendees 'https://docs.microsoft.com/en-us/office/vba/api/outlook.olresponsestatus a(j, 8) = .ResponseStatus End With End If Next i On Error GoTo 0 'Title in row 1. b = Split("Oraganizer,Subject,CreationTime,Start,Location,RequiredAddttendees,OptionalAttendees,ResponseStatus", ",") [A1].Resize(, UBound(b) + 1) = b 'Data from Outlook Sent folder's MeetingItem properties. 'Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(a), UBound(a, 2)).Value = a [A2].Resize(UBound(a), UBound(a, 2)).Value = a ActiveSheet.UsedRange.EntireColumn.AutoFit [A1].Select Set oAA = Nothing Set oM = Nothing Set oG = Nothing Set oApp = Nothing End Sub

Lastly, you might want to search for the appointments in this way rather than Folder items.

https://docs.microsoft.com/en-us/off...ain-a-specific

Thank you very much :)

During the loop I would also like to print the object Outlook>>RecurrencePattern>>StartTime, in order to receive the first date and time of a recurring Calendar item.
How can I access to that variable? I don't get any result if I add the command:

Code:

a(j,9) = Outlook.RecurrencePattern.StartTime

Hopefully you would understand my meaning, if not, take a look here in line "Recurrence Range Start"
https://docs.microsoft.com/en-us/off...ields-overview

Thank you :)