Outlook 365 Searching all shared calendars

Not open for further replies.


New Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
I understand from my research that outlook will not search shared calendars. It will only search for an appointment etc with the current folder.

I have a scenario where I have 3 engineers who have appointments and a client rings up and says "I believe I have made an appointment my address is....., can you check please."

Under the current system I have to do a postcode search in each engineers calendar to see if an appointment has been made. This is time consuming and we are soon going to have 5 engineers.

Is there a way that you can create a macro that will run a search in each shared calendar automatically and produce reports?

This is probably messy code (since I put several macros together) but it should work - and might need tweaked a bit more. It asks for a keyword to search for then searches for recent appointments containing that word in the body or subject.

Like the print calendar I used as the base, you need to select calendar you want to search. if it finds a match on a calendar, a dialog box says which calendar then go to the next calendar.

 Dim CalFolder As Outlook.Folder
 Dim nameFolder
Dim strKeyword
 ' Run this macro
 Sub SearchinSharedCalendars()
 Dim objPane As Outlook.NavigationPane
 Dim objModule As Outlook.CalendarModule
 Dim objGroup As Outlook.NavigationGroup
 Dim objNavFolder As Outlook.NavigationFolder
 Dim objCalendar As Folder
 Dim objFolder As Folder

 Dim i As Integer
 Dim g As Integer

 On Error Resume Next

 Set objCalendar = Session.GetDefaultFolder(olFolderCalendar)

 Set Application.ActiveExplorer.CurrentFolder = objCalendar
strKeyword = InputBox("Search subject and body for", "Search Shard Calendars")

 Set objPane = Application.ActiveExplorer.NavigationPane
 Set objModule = objPane.Modules.GetNavigationModule(olModuleCalendar)

 With objModule.NavigationGroups

 For g = 1 To .Count

 Set objGroup = .Item(g)

 For i = 1 To objGroup.NavigationFolders.Count
 Set objNavFolder = objGroup.NavigationFolders.Item(i)

 If objNavFolder.IsSelected = True Then

 'run macro to copy appt
 Set CalFolder = objNavFolder.Folder
 Set nameFolder = objNavFolder

 Dim NS As Outlook.NameSpace
 Dim objOwner As Outlook.Recipient
 Set NS = Application.GetNamespace("MAPI")
 Set objOwner = NS.CreateRecipient(nameFolder)
 If objOwner.Resolved Then
 Set CalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
 End If


 End If
 Next i
 Next g
 End With

 Set objPane = Nothing
 Set objModule = Nothing
 Set objGroup = Nothing
 Set objNavFolder = Nothing
 Set objCalendar = Nothing
 Set objFolder = Nothing
 End Sub

 Private Sub SearchSharedCalendar()

 Dim CalItems As Outlook.Items
 Dim ResItems As Outlook.Items
 Dim sFilter As String
 Dim iNumRestricted As Integer
 Dim itm, newAppt As Object
Dim oFinalItems As Outlook.Items

 Set CalItems = CalFolder.Items

 If CalFolder = printCal Then
 Exit Sub
 End If

 ' Sort all of the appointments based on the start time
 CalItems.Sort "[Start]"
 CalItems.IncludeRecurrences = True

 On Error Resume Next
 strName = CalFolder.Parent.Name

' searches next 10 days
sFilter = "[Start] >= '" & Date & "'" & " And [Start] < '" & Date + 10 & "'"
Debug.Print sFilter

  'Restrict the Items collection for the 30-day date range
 Set ResItems = CalItems.Restrict(sFilter)
    'Construct filter for Subject containing strKeyword '0x0037001E
    Const PropTag  As String = "http://schemas.microsoft.com/mapi/proptag/"
    sFilter = "@SQL=" & Chr(34) & PropTag _
        & "0x0037001E" & Chr(34) & " like '%" & strKeyword & "%' OR " & Chr(34) & PropTag _
        & "0x1000001f" & Chr(34) & " like '%" & strKeyword & "%'"
Debug.Print sFilter
'Restrict the last set of filtered items for the subject
Set oFinalItems = ResItems.Restrict(sFilter)

'Sort and print final results
oFinalItems.Sort "[Start]"
 iNumRestricted = 0
For Each oAppt In oFinalItems
 iNumRestricted = iNumRestricted + 1
    Debug.Print oAppt.Start, oAppt.Subject, strName
 If iNumRestricted > 0 Then
 MsgBox iNumRestricted & " Matching Appointment found in " & strName
 End If
 Set itm = Nothing
 Set newAppt = Nothing
 Set ResItems = Nothing
 Set CalItems = Nothing
 Set CalFolder = Nothing

 End Sub
It should be interesting to be able to search in different shared calendars in Outlook 2016. It could be useful for schools and educational centers that need to find the same event (named in the same way, normally by the name of the student) in different calendars.
I use it in my work essayedge review very often
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
X Custom icon (not from Office 365) for a macro in Outlook Outlook VBA and Custom Forms 1
T Outlook 365 won't take new working password Using Outlook 0
P Yahoo/IMAP folder rename by Outlook desktop 365 Using Outlook 0
P VBA to add email address to Outlook 365 rule Outlook VBA and Custom Forms 0
Rupert Dragwater Background colors not saving in Outlook 365 Using Outlook 15
J Outlook 365 html inline images Using Outlook 0
Rupert Dragwater How to get Outlook 365 to open from websites Using Outlook 5
HarvMan Outlook 365 - Rule to Move an Incoming Message to Another Folder Using Outlook 4
TomHuckstep Remove Send/Receive All Folders (IMAP/POP) button from Outlook 365 Ribbon Using Outlook 2
A Outlook 365 Outlook (part of 365) now working offline - argh Using Outlook 5
G LinkedIn tab missing in Outlook 365 (but working in OWA) Using Outlook 0
P now on office 365 but getting error messages about missing Outlook 2013 cache folders Using Outlook 2
L Synch Outlook 365 calendar with iPhone Using Outlook 0
D Outlook 365 Custom forms field limit? Outlook VBA and Custom Forms 4
J Outlook 2016 Trying to get Outlook 2016 to work with Office 365 Using Outlook 0
L Duplicate calendar entries in Outlook 365 Using Outlook 3
G Stop Outlook 365 adding meetings to calendar Using Outlook 1
HarvMan Using Emojis in Outlook 365 Using Outlook 3
T Outlook 2019 Not Using Auto Compete After Deletion of 365 Using Outlook 1
CWM330 Is it me, or is Outlook 365 BUGGY? Using Outlook 3
K Outlook 365 After migrating to Outlook 365, some contacts display in emails with prefixes Using Outlook 0
HarvMan Outlook 365 loses "outlook.com" exchange server settings Using Outlook 1
D Office 365 Outlook desktop app prompts for all account passwords on startup Using Outlook 11
L Recommendations for Utility to Backup Outlook 365 Account Settings Using Outlook 2
Z New minimum Outlook for Windows version requirements for Microsoft 365/Exchange Online Using Outlook.com accounts in Outlook 27
kburrows Outlook 365 - Ribbon Customizations Disappear Using Outlook 0
C Why does Outlook (desktop) 365 for Windows keep making me input my passwords? Using Outlook 12
J Outlook 365 Outlook 2016/365 Contacts Lose Info when Favorited to the To-Do Bar Using Outlook 2
O Outlook 365 - Gmail and Outlook: how to force Outlook to start up in Gmail? Using Outlook 2
M Outlook 365 refuses to send email Using Outlook 0
P How can I stop Outlook 365 duplicating the posts? Using Outlook 1
HarvMan Toggle between calendar and email in Outlook 365 Using Outlook 12
S Mac Outlook 365 Questions Using Outlook 1
R Outlook 365 update sets delete from server flag Using Outlook 1
O Outlook 365 - How to create / copy a new contact from an existing one? Using Outlook 5
F Excel VBA to move mails for outlook 365 on secondary mail account Outlook VBA and Custom Forms 1
F Outlook 365 is "Possessed" Using Outlook 2
K Outlook Office 365 VBA download attachment Outlook VBA and Custom Forms 2
AmonRa Outlook 365 calendar - too much white space Using Outlook 0
G Outlook 365 with iCloud account not syncing calendars Using Outlook 2
L Ideas for Setup with New Office 365 Family Subscription (Outlook) Using Outlook.com accounts in Outlook 3
D Connecting Gmail to Outlook 365 - My Setup not working Using Outlook 2
Z Outlook 365 delete reminder you can’t make change to contents of this-read only folder Using Outlook 4
D Outlook 2016 how to use gmail account as source account for outlook 365 Using Outlook 9
M outlook 365 trying to finish my sentences Using Outlook 2
C Not sync folders not found after MS Outlook 365 update Using Outlook 1
D Outlook 2007 on 365 Using Outlook.com accounts in Outlook 2
Terry Sullivan Sender's Name Doesn't Appear in the From Field on Outlook 365/IMAP Using Outlook 2
A Backup Email Accounts On OutLook For Mac 2016 (Microsoft 365 subscription version) Using Outlook 0
X Using Outlook 2013 and Outlook 365 Using Outlook 1

Similar threads