Problème macro Excel>>Outlook

edberg67

XLDnaute Nouveau
Bonjour à tous,

J'ai un petit soucis sur une macro VBA que j'ai faite.
J'ai un fichier Excel avec des dates de relances. J'ai écris une macro me permettant de créer des rappels dans outlook en fonction de la date de relance saisie dans excel.
Mon soucis, c'est que dès que je rajoute une ligne ou modifie une date, il me recopie toutes les lignes, donc il y a des doublons dans outlook.
je ne voudrais copier que les lignes ou il y a eu du changement, ou alors effacer les rappel outlokk avant de les recopier..Mais je beug!!!
Je vous mets mon code pour le transfert outlook:
Set OutObj = CreateObject("outlook.application")
' Avec la feuille
With Sheets("Suivi")
DLig = .Range("D" & Rows.Count).End(xlUp).Row
' Pour chaque ligne
For Lig = 5 To DLig
' Si une date de relance existe
If .Range("I" & Lig) <> "" Then
' Si un RDV n'a pas déjà été créé
FlgRdv = True
Else
FlgRdv = False
End If
' Si le FLAG est à vrai on créé le RDV
If FlgRdv Then
DateRdv = Range("I" & Lig)
Set OutAppt = OutObj.CreateItem(olAppointmentItem)
With OutAppt
.Subject = "Rappeler " & Sheets("Suivi").Range("D" & Lig)
.Start = DateRdv & " 08:00"
.Duration = 30
.ReminderSet = True
.Save
End With

End If
Next Lig
End With
Set OutAppt = Nothing
End If

Merci à tous pour votre aide!!
A bientôt
 

Lone-wolf

XLDnaute Barbatruc
Bonjour edberg

Il faut modifier ces lignes

DLig = .Range("D" & Rows.Count).End(xlUp).Row

' Si une date de relance existe
If (.Range("I" & Lig) <> "" Then

Par
DLig = .Range("I" & Rows.Count).End(xlUp).Row
If .Range("I" & Lig).Value = Date Then
 

Discussions similaires

Réponses
14
Affichages
749

Statistiques des forums

Discussions
312 947
Messages
2 093 842
Membres
105 851
dernier inscrit
aviato