Hi
i've been using this code to send a teams invitation till now (dunno actually when it stopped to work) , but now when outlook opens the "send from" is blank and i cannot chose the correct my email (i can if i start a new meeting manually)
code:




Code:
Public Function CreateAppt(Richiesto As Recordset, DataInizio As Date, Subj, MailFrom As String, BodyTXT, Inizio, Fine As String, Teams As Boolean, Optional Ind As String, Optional Opzionale As Recordset, Optional Risorsa As Recordset)   Dim olApp As Outlook.Application
   Dim olAppItem As Outlook.AppointmentItem
   Dim m As Outlook.MailItem
   Dim oAccount As Outlook.Account
   Dim txt As String
   Dim myRequiredAttendee, myOptionalAttendee, myResourceAttendee As Outlook.Recipient
   
   Set olApp = GetObject("", "Outlook.Application")


   
   For Each oAccount In olApp.Session.Accounts   'Application.Session.Accounts <<Application in this context refers to Access not Outlook>>
      If oAccount = MailFrom Then
         Set m = olApp.CreateItem(olMailItem) 'creo mail per formnattazione html non presente in meeting
         Set olAppItem = olApp.CreateItem(olAppointmentItem)
         With olAppItem
            .MeetingStatus = olMeeting
            
            .SUBJECT = Subj
            .Location = Ind
            .Start = FormatDateTime(DataInizio & " " & Inizio) '#9/24/2009 1:30:00 PM#
            '.Body = BodyTXT ' utilizzo l'oggetto mail sotto
            .Duration = (Left(Fine, 2) - Left(Inizio, 2)) * 60 + Right(Fine, 2) - Right(Inizio, 2)
            .ReminderMinutesBeforeStart = 15
            .ResponseRequested = True
            .SendUsingAccount = oAccount
            If Teams Then 'se non è una teams inserisco anche il luogo
            Else
               .Location = Ind
            End If
         End With
      
      
         Do Until Richiesto.EOF
            Set myRequiredAttendee = olAppItem.Recipients.Add(Richiesto!Email)
            myRequiredAttendee.Type = olRequired
            Richiesto.MoveNext
         Loop
         If Not Opzionale Is Nothing Then
            Do Until Opzionale.EOF
               Set myOptionalAttendee = olAppItem.Recipients.Add(Opzionale!Email)
               myRequiredAttendee.Type = olOptional
               Opzionale.MoveNext
            Loop
         End If
         If Not Risorsa Is Nothing Then
            Do Until Risorsa.EOF
               Set myResourceAttendee = olAppItem.Recipients.Add(Risorsa!Email)
               myRequiredAttendee.Type = olResource
               Risorsa.MoveNext
            Loop
         End If
         
         olAppItem.Display
'         m.BodyFormat = olFormatHTML ' dopo il display setto l'oggetto mail al formato html
'         m.HTMLBody = BodyTXT
'         m.GetInspector().WordEditor.Range.FormattedText.Copy 'setto il corpo della mail al testo che ho selezionato
'         olAppItem.GetInspector().WordEditor.Range.FormattedText.Paste 'setto il corpo della mail al testo che ho selezionato
         If IDCalendarioVideo <> "" Then
            DoCmd.SetWarnings False
            DoCmd.RunSQL ("UPDATE Calendario SET Calendario.IDvideo =""" & olAppItem.GlobalAppointmentID & """ WHERE (((Calendario.IDCalendario)=" & IDCalendarioVideo & "));")
            IDCalendarioVideo = ""
            DoCmd.SetWarnings True
         End If
         If Teams Then
            SendKeys "{F10}", True 'rende visibili i tasti rapidi
            'Switch to ribbon shortcuts
            SendKeys "H", True 'SendKeys "%H", True
            'Hit the Microsoft teams meetings button, requires teams to be installed
            SendKeys "TM", True
         End If
      End If
   Next
   'olAppItem.Send
End Function