Consulting

Results 1 to 5 of 5

Thread: Count the number of scheduling each appointment

  1. #1
    VBAX Regular
    Joined
    Mar 2019
    Posts
    10
    Location

    Arrow 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! :-)

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    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.

    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().
    '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

  3. #3
    VBAX Regular
    Joined
    Mar 2019
    Posts
    10
    Location
    Quote Originally Posted by Kenneth Hobs View Post
    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:

    1. 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?
    2. 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

  4. #4
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    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.

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

  5. #5
    VBAX Regular
    Joined
    Mar 2019
    Posts
    10
    Location
    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:
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •