Microsoft 365 Combiner une condition avec une boucle dans VBA

[CHL1234]

Bonjour,

Je cherche à automatiser avec VBA l'envoi d'invitations Outlook à partir d'un planning en deux dimensions (noms des personnes vs dates). J'ai tout d'abord créé un onglet pour ramener les données sous forme d'un fichier plat, ce qui permet à la macro, construite à partir de différents tutos en ligne, de fonctionner plutôt bien, notamment en utilisant une boucle "With / End With". J'aimerais pouvoir intégrer une condition. En effet, il se peut qu'aucune invitation ne doive être envoyée à la personne (car rien de renseigné dans son planning) : j'aimerais que dans ce cas, la macro passe à la ligne suivante. Je suppose qu'il faut intégrer quelque part un If/Then/Else, mais je n'arrive pas à le positionner correctement.
Sauriez-vous m'aider ?
Voici le code ci-après, et un visuel du fichier en pièce jointe

Sub SendInviteToMultiple()
Dim OutApp As Outlook.Application, Outmeet As Outlook.AppointmentItem
Dim I As Long, setupsht As Worksheet

Set setupsht = Worksheets("Envoi Invitations")

For I = 8 To Range("B5")
Set OutApp = Outlook.Application
Set Outmeet = OutApp.CreateItem(olAppointmentItem)

With Outmeet
.Subject = setupsht.Range("G" & I).Value
.RequiredAttendees = setupsht.Range("E" & I).Value
.OptionalAttendees = setupsht.Range("F" & I).Value
.Start = setupsht.Range("C" & I).Value
.Duration = setupsht.Range("D" & I).Value
.Importance = olImportanceHigh
.Body = setupsht.Range("H" & I).Value
.Location = setupsht.Range("G" & I).Value
.MeetingStatus = olMeeting
.ReminderMinutesBeforeStart = 15
.Display
'.Send
End With

Next I
Set OutApp = Nothing
Set Outmeet = Nothing

MsgBox ("La macro s'est correctement exécutée !")

End Sub

Merci d'avance pour votre aide !

 

[mapomme]

Bonjour @CHL1234 ,

On peut n'exécuter les instructions de la boucle que si des conditions sont vérifiées avec un IF... en début de boucle et un End IF en fin de boucle.

   For I = 8 To setupsht.Cells(Rows.Count, "b").End(xlUp).Row
      If InStr(1, setupsht.Cells(I, "i"), "Pas", vbTextCompare) = 0 And setupsht.Cells(I, "a") <> "" Then
         Set OutApp = Outlook.Application
         Set Outmeet = OutApp.CreateItem(olAppointmentItem)
         With Outmeet
            .Subject = setupsht.Range("G" & I).Value
            .RequiredAttendees = setupsht.Range("E" & I).Value
            .OptionalAttendees = setupsht.Range("F" & I).Value
            .Start = setupsht.Range("C" & I).Value
            .Duration = setupsht.Range("D" & I).Value
            .Importance = olImportanceHigh
            .Body = setupsht.Range("H" & I).Value
            .Location = setupsht.Range("G" & I).Value
            .MeetingStatus = olMeeting
            .ReminderMinutesBeforeStart = 15
            .Display
            '.Send
         End With
      End If
   Next I

 

[CHL1234]

Rebonjour,
Cela fonctionne parfaitement. Merci beaucoup !
Belle journée !