carlAlex
8/31/2016 - 9:26 AM

Excel - Outlook

Excel - Outlook

Option Explicit
 
Sub ListAppointments()
     
    Dim olApp As Object
    Dim olNS As Object
    Dim olFolder As Object
    Dim olApt As Object
    Dim NextRow As Long
     
    Set olApp = CreateObject("Outlook.Application")
     
    Set olNS = olApp.GetNamespace("MAPI")
     
    Set olFolder = olNS.GetDefaultFolder(9) 'olFolderCalendar
     
    Range("A1:D1").Value = Array("Subject", "Start", "End", "Location")
     
    NextRow = 2
     
    For Each olApt In olFolder.Items
        Cells(NextRow, "A").Value = olApt.Subject
        Cells(NextRow, "B").Value = olApt.Start
        Cells(NextRow, "C").Value = olApt.End
        Cells(NextRow, "D").Value = olApt.Location
        NextRow = NextRow + 1
    Next olApt
     
    Set olApt = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
     
    Columns.AutoFit
     
End Sub
Option Explicit

' VBA Script that gets list of Outlook Calendar Appointments and their Properties and uses the Property Accessor
' Use Tools->Macro->Security to allow Macros to run, then restart Outlook
' Run Outlook, Press Alt+F11 to open VBA
' Programming by Greg Thatcher, http://www.GregThatcher.com
' See http://www.GregThatcher.com for other ways to get the properties of Appointments
Public Sub GetListOfAppointmentsUsingPropertyAccessor()
    On Error GoTo On_Error
    
    Dim Session As Outlook.NameSpace
    Dim Report As String
    Dim AppointmentsFolder As Outlook.Folder
    Dim currentItem As Object
    Dim currentAppointment As AppointmentItem
    Set Session = Application.Session
    
    Set AppointmentsFolder = Session.GetDefaultFolder(olFolderCalendar)
    
    For Each currentItem In AppointmentsFolder.Items
        If (currentItem.Class = olAppointment) Then
            Set currentAppointment = currentItem
            
            'Call AddToReportIfNotBlank(Report, "Actions", currentAppointment.Actions)
            Call AddToReportIfNotBlank(Report, "AllDayEvent", currentAppointment.AllDayEvent)
            ' Call AddToReportIfNotBlank(Report, "Attachments", currentAppointment.Attachments)
            Call AddToReportIfNotBlank(Report, "AutoResolvedWinner", currentAppointment.AutoResolvedWinner)
            Call AddToReportIfNotBlank(Report, "BillingInformation", currentAppointment.BillingInformation)
            Call AddToReportIfNotBlank(Report, "Body", currentAppointment.Body)
            Call AddToReportIfNotBlank(Report, "BusyStatus", currentAppointment.BusyStatus)
            Call AddToReportIfNotBlank(Report, "Categories", currentAppointment.Categories)
            Call AddToReportIfNotBlank(Report, "Class", currentAppointment.Class)
            Call AddToReportIfNotBlank(Report, "Companies", currentAppointment.Companies)
            ' Call AddToReportIfNotBlank(Report, "Conflicts", currentAppointment.Conflicts)
            ' Call AddToReportIfNotBlank(Report, "ConversationID", currentAppointment.ConversationID)
            Call AddToReportIfNotBlank(Report, "ConversationIndex", currentAppointment.ConversationIndex)
            Call AddToReportIfNotBlank(Report, "ConversationTopic", currentAppointment.ConversationTopic)
            Call AddToReportIfNotBlank(Report, "CreationTime", currentAppointment.CreationTime)
            Call AddToReportIfNotBlank(Report, "DownloadState", currentAppointment.DownloadState)
            Call AddToReportIfNotBlank(Report, "Duration", currentAppointment.Duration)
            Call AddToReportIfNotBlank(Report, "End", currentAppointment.End)
            Call AddToReportIfNotBlank(Report, "EndInEndTimeZone", currentAppointment.EndInEndTimeZone)
            Call AddToReportIfNotBlank(Report, "EndTimeZone", currentAppointment.EndTimeZone)
            Call AddToReportIfNotBlank(Report, "EndUTC", currentAppointment.EndUTC)
            
            Call AddToReportIfNotBlank(Report, "EntryID", currentAppointment.EntryID)
            Call AddToReportIfNotBlank(Report, "ForceUpdateToAllAttendees", currentAppointment.ForceUpdateToAllAttendees)
            Call AddToReportIfNotBlank(Report, "FormDescription", currentAppointment.FormDescription)
            Call AddToReportIfNotBlank(Report, "GlobalAppointmentID", currentAppointment.GlobalAppointmentID)
            Call AddToReportIfNotBlank(Report, "Importance", currentAppointment.Importance)
            Call AddToReportIfNotBlank(Report, "InternetCodepage", currentAppointment.InternetCodepage)
            Call AddToReportIfNotBlank(Report, "IsConflict", currentAppointment.IsConflict)
            Call AddToReportIfNotBlank(Report, "IsRecurring", currentAppointment.IsRecurring)
            ' Call AddToReportIfNotBlank(Report, "ItemProperties", currentAppointment.ItemProperties)
            Call AddToReportIfNotBlank(Report, "LastModificationTime", currentAppointment.LastModificationTime)
            
            ' Call AddToReportIfNotBlank(Report, "Links", currentAppointment.Links)
            Call AddToReportIfNotBlank(Report, "Location", currentAppointment.Location)
            Call AddToReportIfNotBlank(Report, "MarkForDownload", currentAppointment.MarkForDownload)
            Call AddToReportIfNotBlank(Report, "MeetingStatus", currentAppointment.MeetingStatus)
            Call AddToReportIfNotBlank(Report, "MeetingWorkspaceURL", currentAppointment.MeetingWorkspaceURL)
            Call AddToReportIfNotBlank(Report, "MessageClass", currentAppointment.MessageClass)
            Call AddToReportIfNotBlank(Report, "Mileage", currentAppointment.Mileage)
            Call AddToReportIfNotBlank(Report, "NoAging", currentAppointment.NoAging)
            Call AddToReportIfNotBlank(Report, "OptionalAttendees", currentAppointment.OptionalAttendees)
            Call AddToReportIfNotBlank(Report, "Organizer", currentAppointment.Organizer)
            
            Call AddToReportIfNotBlank(Report, "OutlookInternalVersion", currentAppointment.OutlookInternalVersion)
            Call AddToReportIfNotBlank(Report, "OutlookVersion", currentAppointment.OutlookVersion)
            ' Call AddToReportIfNotBlank(Report, "Recipients", currentAppointment.Recipients)
            Call AddToReportIfNotBlank(Report, "RecurrenceState", currentAppointment.RecurrenceState)
            Call AddToReportIfNotBlank(Report, "ReminderMinutesBeforeStart", currentAppointment.ReminderMinutesBeforeStart)
            Call AddToReportIfNotBlank(Report, "ReminderOverrideDefault", currentAppointment.ReminderOverrideDefault)
            Call AddToReportIfNotBlank(Report, "ReminderPlaySound", currentAppointment.ReminderPlaySound)
            Call AddToReportIfNotBlank(Report, "ReminderSet", currentAppointment.ReminderSet)
            Call AddToReportIfNotBlank(Report, "ReminderSoundFile", currentAppointment.ReminderSoundFile)
            Call AddToReportIfNotBlank(Report, "ReplyTime", currentAppointment.ReplyTime)
            
            
            Call AddToReportIfNotBlank(Report, "RequiredAttendees", currentAppointment.RequiredAttendees)
            Call AddToReportIfNotBlank(Report, "Resources", currentAppointment.Resources)
            Call AddToReportIfNotBlank(Report, "ResponseRequested", currentAppointment.ResponseRequested)
            Call AddToReportIfNotBlank(Report, "ResponseStatus", currentAppointment.ResponseStatus)
            ' Call AddToReportIfNotBlank(Report, "RTFBody", currentAppointment.RTFBody)
            Call AddToReportIfNotBlank(Report, "Saved", currentAppointment.Saved)
            ' Call AddToReportIfNotBlank(Report, "SendUsingAccount", currentAppointment.SendUsingAccount)
            Call AddToReportIfNotBlank(Report, "Sensitivity", currentAppointment.Sensitivity)
            Call AddToReportIfNotBlank(Report, "Size", currentAppointment.Size)
            Call AddToReportIfNotBlank(Report, "Start", currentAppointment.Start)
            
            Call AddToReportIfNotBlank(Report, "StartTimeZone", currentAppointment.StartTimeZone)
            Call AddToReportIfNotBlank(Report, "StartUTC", currentAppointment.StartUTC)
            Call AddToReportIfNotBlank(Report, "Subject", currentAppointment.Subject)
            Call AddToReportIfNotBlank(Report, "UnRead", currentAppointment.UnRead)
            ' Call AddToReportIfNotBlank(Report, "UserProperties", currentAppointment.UserProperties)
            
            Report = Report & "--------------------------------------------------------------------------------------------------------"
            Report = Report & vbCrLf & vbCrLf
        End If
        
    Next
    
    
    Call CreateReportAsEmail("List of Appointments", Report)
    
Exiting:
        Exit Sub
On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting
    
End Sub

Private Function AddToReportIfNotBlank(Report As String, FieldName As String, FieldValue)
    AddToReportIfNotBlank = ""
    If (IsNull(FieldValue) Or FieldValue <> "") Then
        AddToReportIfNotBlank = FieldName & " : " & FieldValue & vbCrLf
        Report = Report & AddToReportIfNotBlank
    End If
    
End Function

' VBA SubRoutine which displays a report inside an email
' Programming by Greg Thatcher, http://www.GregThatcher.com
Public Sub CreateReportAsEmail(Title As String, Report As String)
    On Error GoTo On_Error
    
    Dim Session As Outlook.NameSpace
    Dim mail As MailItem
    Dim MyAddress As addressEntry
    Dim Inbox As Outlook.Folder
    
    Set Session = Application.Session
    Set Inbox = Session.GetDefaultFolder(olFolderInbox)
    Set mail = Inbox.Items.Add("IPM.Mail")
    
    Set MyAddress = Session.CurrentUser.addressEntry
    mail.Recipients.Add (MyAddress.Address)
    mail.Recipients.ResolveAll
    
    mail.Subject = Title
    mail.Body = Report
    
    mail.Save
    mail.Display
    
    
Exiting:
        Set Session = Nothing
        Exit Sub
On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting

End Sub
Sub InspectAppointment()

    Dim Session As Outlook.NameSpace
    Dim Report As String
    Dim AppointmentsFolder As Outlook.Folder
    Dim currentItem As Object
    Dim currentAppointment As AppointmentItem
    Set Session = Application.Session
    
    Set AppointmentsFolder = Session.GetDefaultFolder(olFolderCalendar)
    
    For Each currentItem In AppointmentsFolder.Items
        If (currentItem.Class = olAppointment) Then
            '"Watch" currentAppointment to see what info a appointment Item stores
            Set currentAppointment = currentItem
        End If
    Next
    
End Sub