XL 2010 Macro pour supprimer des rdv Outlook en fonction de leur objet via Excel

jozerebel

XLDnaute Occasionnel
Bonjour le Forum,

Je souhaite supprimer des rendez vous Outlook qui ont un titre bien précis. J'ai glané une macro et l'ai un peu adaptée. Cependant quand je la lance, elle tourne et tourne...... et je suis obligé de l interrompre. Je pense que c'est parce que je ne filtre pas sur une période et du coup, la macro recherche dans tout mon calendrier.

Quelqu'un peut-il m'aider svp?

D'avance merci.

Sub SupprimerRDV()

Dim OlApp As New Outlook.Application
Dim OlMapi As Outlook.Namespace
Dim OlFolder As Outlook.MAPIFolder
Dim OlItems As Outlook.Items
Dim OlAppointment As Outlook.AppointmentItem
Dim lig As Long


With Sheets("synthese")

For lig = 3 To 148

For Each OlAppointment In OlItems
If OlAppointment.Subject = "RELANCE " & Sheets("synthese").Range("B1") & " " & Sheets("synthese").Range("A" & lig) Then OlAppointment.Delete
.Range("C" & lig) = ""

Next
End If
Next



End With



Set OlItems = Nothing
Set OlMapi = Nothing
Set OlApp = Nothing

End Sub
 

Lone-wolf

XLDnaute Barbatruc
Bonsoir jozerebel

Un essai comme ceci

VB:
With Sheets("synthese")
derlig = .Range("a" & Rows.Count).End(xlUp).Row

For lig = 3 To derlig
nom = nom & .Range("b1") & " " & .Range("a" & lig)
Next
End With

For Each OlAppointment In OlItems
If OlAppointment.Subject = "RELANCE " & nom Then
OlAppointment.Delete
End If
Next
Sheets("synthese").Range("c2:c65536").ClearContents
 

Discussions similaires

Statistiques des forums

Discussions
312 198
Messages
2 086 117
Membres
103 121
dernier inscrit
SophieS