Outlook VBA, show meeting series expiring in the next 30 days - vba

Question

I am trying to adapt an outlook vba script that shows if a named meeting series is expiring on that day. I would like to make it look through all my meeting series, and show a reminder message for any when the end date is within the next 30 days.
Here is a start of what I currently have that will work if I supply the one meeting name (TestRecur):
Sub ExtendAppointmentSample()
Dim myApptItem As Outlook.AppointmentItem
Dim myRecurrPatt As Outlook.RecurrencePattern
Dim myNamespace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim QuestionToMessageBox
QuestionToMessageBox = "Appointment is about to expire, would you like to extend it?"
Set myNamespace = Application.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderCalendar)
Set myItems = myFolder.Items
' specify the Item Object here but I would like it to cycle through all meeting series and look for those ending within 30 days
Set myApptItem = myItems.Item("TestRecur")
Set myRecurrPatt = myApptItem.GetRecurrencePattern
If myRecurrPatt.PatternEndDate < DateAdd("d", 30, Date) Then
YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbInformation, "Extend")
'Next line does not work; not sure how to get each Meeting Title
'MsgBox (MeetingTitle)
End If
End Sub

Answer 1

show meeting series expiring in the next 30 days
In that case you need to find all meetings that take place during these 30 days in the calendar. Then you can check their PatternEndDate property value when they ends. To get all calendar items for a specific time frame you can use the Find/FindNext or Restrict methods of the Items class. Read more about these methods in the articles that I wrote for the technical blog:
How To: Retrieve Outlook calendar items using Find and FindNext methods
How To: Use Restrict method in Outlook to get calendar items
For example, you may use the following code to find appointments for a specific time frame (VB.NET):
Private Sub FindActiveAppointments(folder As Outlook.MAPIFolder)
Dim dateTimeStart As String = DateTime.Now.ToString("MM/dd/yyyy hh:mm tt")
Dim dt As DateTime = New DateTime(DateTime.Now.Year, DateTime.Now.Month, _
DateTime.Now.Day, 23, 59, 0, 0)
Dim dateTimeEnd As String = dt.ToString("MM/dd/yyyy hh:mm tt")
Dim searchCriteria As String = "[Start]<=""" + dateTimeEnd + """ AND [End]>=""" + _
dateTimeStart + """"
Dim strBuilder As StringBuilder = Nothing
Dim counter As Integer = 0
Dim appItem As Outlook._AppointmentItem = Nothing
Dim folderItems As Outlook.Items = Nothing
Dim resultItem As Object = Nothing
folderItems = folder.Items
folderItems.IncludeRecurrences = True
folderItems.Sort("[Start]")
If (folderItems.Count > 0) Then
resultItem = folderItems.Find(searchCriteria)
If Not IsNothing(resultItem) Then
strBuilder = New StringBuilder()
Do
If (TypeOf (resultItem) Is Outlook._AppointmentItem) Then
counter += 1
appItem = resultItem
strBuilder.AppendLine("#" + counter.ToString() + _
" Subbject: " + appItem.Subject + _
" Organizer: " + appItem.Organizer + _
" Location: " + appItem.Location)
End If
resultItem = folderItems.FindNext()
Loop Until IsNothing(resultItem)
End If
End If
If Not IsNothing(strBuilder) Then
Debug.WriteLine(strBuilder.ToString())
Else
Debug.WriteLine("There is no match in the " + _
folder.Name + " folder.")
End If
End Sub