VBA création automatique RDV Outlook

Bonjour et merci d'avance pour votre aide.

Je viens de m'appuyer sur des bouts de code trouvés sur ce forum pour créer celui qui me servira à créer automatiquement des RDV Outlook.

Le code doit me permettre pour chacune des lignes du tableau :

- de créer un rdv à la date correspondante à la colonne J à condition qu'il y ait une date dans la colonne I et quelle soit blanche

- de colorier les colonnes I & J lorsque le rdv a été créé dans Outlook

Or il y a un bug à la ligne 23 mais je ne sais pas de quoi cela provient.

Par ailleurs, il y a des lignes de codes que j'ai laissées par prévention mais je ne sais pas à quoi elles servent..

Sub Ajouterdesrdv()

    Dim I As Long
    Dim xRg As Range
    Dim xOutApp As Object
    Dim xOutItem As Object
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = Range("A7:M1000")                                                                                     'Plage du tableau de données
        For I = 1 To xRg.Rows.Count                                                                                 'Création de la boucle
            If Cells(I + 1, 9).Interior.Color = RGB(255, 255, 255) And Cells(I + 1, 9) <> "" Then                   'Si la couleur de la cellule est blanche & non vide
                Set xOutItem = xOutApp.createitem(1)                                                                'Utilise une fonction de Outlook
                Debug.Print xRg.Cells(I, 1).Value 'Je ne sais pas à quoi sert cette ligne de code
                xOutItem.Subject = "Vérification périodique " + xRg.Cells(I, 1).Value + xRg.Cells(I, 2).Value       'Titre du Rendez-vous avec colonne A & colonne B
                xOutItem.Start = xRg.Cells(I, 10).Value                                                             'Date du Rendez-vous avec colonne J
                xOutItem.Body = "Vérification périodique " + xRg.Cells(I, 1).Value + xRg.Cells(I, 2).Value          'Corps du Rendez-vous avec colonne A & colonne B
                xOutItem.Save 'Je ne sais pas à quoi sert cette ligne de code
                Set xOutItem = Nothing 'Je ne sais pas à quoi sert cette ligne de code
                Cells(I + 1, 9).Interior.Color = RGB(255, 255, 0)                                                   'Colorie couleur de la cellule en jaune sur colonne I
                Cells(I + 1, 10).Interior.Color = RGB(255, 255, 0)                                                  'Colorie couleur de la cellule en jaune sur colonne J
            Else
            End If
        Next
    Set xOutApp = Nothing
End Sub
Rechercher des sujets similaires à "vba creation automatique rdv outlook"