Szdnez
Szdnez

Reputation: 69

How to create an appointment in Outlook with VBA including a Microsoft Teams invitation?

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

Answers (0)

Related Questions