Reputation: 69
I want to create a set of appointments in Outlook with a rolling number in the title, for instance numbered scrum events: Review P1.1, Review P1.2, ... Therefore I cannot do it with the UI and tried it with a VBA script. So far it works quite well but the appointment should also include a Teams integration and that makes trouble. Can somebody give a hint how to add Teams to the appointment in the right way? I am also open for any other suggestions, it must not be a VBA script.
Sub CreateNumberedRecurringMeetings()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olMeetingItem As Outlook.AppointmentItem
Dim seriesCount As Integer
Dim i As Integer
Dim recipients As String
Dim recArray() As String
Dim j As Integer
Set olApp = Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
seriesCount = InputBox("Number of appointments:", "Number of appointments")
recipients = InputBox("Recipients (;):", "Recipients")
recArray = Split(recipients, ";")
For i = 1 To seriesCount
Set olMeetingItem = olFolder.Items.Add(olAppointmentItem)
With olMeetingItem
.MeetingStatus = olMeeting
.Subject = "Review P1." & i
.Start = DateAdd("d", (i - 1) * 7, #5/1/2025 10:00:00 AM#)
.Duration = 60
.ReminderSet = True
.ReminderMinutesBeforeStart = 15
For j = LBound(recArray) To UBound(recArray)
.recipients.Add recArray(j)
Next j
.recipients.ResolveAll
' Teams-integration that makes trouble
olMeetingItem.GetInspector.CommandBars.ExecuteMso ("TeamsMeeting")
.Save
End With
Next i
MsgBox seriesCount & " apointments created.", vbInformation, "Done"
End Sub
Upvotes: 0
Views: 60