Module VBA pour supprimer des rendez-vous sur Outlook

Bonjour à tous,

Je me sers d'un fichier excel qui contient des modules pour gérer des dates de relance sur outlook, dans un calendrier partagé.

Ce fichier était jusqu'à présent utile et j'avais fait les bonnes macro pour gérer cela avec un calendrier non partagé.

C'est depuis peu que j'ai besoin que cela soit fonctionnel sur un calendrier partagé.

Pour cela j'ai du adapter la sélection du calendrier dans outlook pour faire en sorte qui trouve le fameux fichier partagé sur lequel les dates vont se mettre...

J'ai deux macros

1 / La première supprime tous les rendez-vous du calendrier pour arriver au point 2

2/ La seconde macro ajoute toutes les dates de l'onglet concerné.

(grâce à cette méthode, je peux gérer les dates modifiées et éviter que des doublons de dates se fassent... En gros, je purge le calendrier pour ajouter les dates après modification du fichier excel...)

Je n'ai aucun soucis avec la macro n°1.

Pour la n°2, cela fonctionne mais ça me fait planter outlook après le lancement... (bug, mails que ne s'affiche plus et fermeture intempestive de outlook)

Je vous mets le code du module de suppression pour quelqu'un qui voudrait bien essayer d'apporter une solution à mon problème...

Je pense que le soucis vient de la plage de données, car quand je réduis ("A2:A10" par exemple) je n'ai aucun soucis... Dans mon code, vous verre, j'ai mis "A2:A1000" mais je suis obligé car le nombre de ligne n'est pas fixe...

Mais voilà je bloque....

Je reste à votre disposition si besoin

Merci bien

Sub supprime()

Dim OutlApp As New Outlook.Application
Dim OutlItems As Outlook.Items
Dim OutlMapi As Outlook.Namespace
Dim OutlFolder As Outlook.MAPIFolder
Dim Cell As Range
Dim cal As String
Dim appt As Outlook.AppointmentItem
Dim ol As Outlook.Application
Dim olns As Outlook.Namespace
Dim myRecipient As Outlook.Recipient
Dim myFolder As Outlook.Folder
Dim objExpCal As Outlook.Explorer
Dim objNavMod As Outlook.CalendarModule
Dim objNavGroup As Outlook.NavigationGroup
Dim objNavFolder As Outlook.NavigationFolder
Dim objAppt As AppointmentItem

'plage de donnée

For Each Cell In Sheets("RECAP").Range("A2:A1000")
'fin de plage de donnée

'Crée la sélection du calendrier dans Outlook
Set OutObj = CreateObject("outlook.application")

Set ol = New Outlook.Application
Set olns = ol.Session
Set objExpCal = olns.GetDefaultFolder(olFolderCalendar).GetExplorer
Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
Set objNavGroup = objNavMod.NavigationGroups.GetDefaultNavigationGroup(olPeopleFoldersGroup)
Set objAppt = ol.CreateItem(olAppointmentItem)
If olns.DefaultStore.DisplayName = "nom.prénom@societe.com" Then
'cas où le propriétaire du calendrier partagé fait l'opération
    Set myFolder = olns.GetDefaultFolder(olFolderCalendar)
    Set Mysubfolder = myFolder.Folders("PROSPECTION").Items ' Indiquer nom calendrier du propriétaire
Else
'cas où un autre utilisateur ayant les droits d'éditeur fait l'opération
   Set myRecipient = olns.CreateRecipient("Prénom Nom")
       myRecipient.Resolve
    If myRecipient.Resolved Then
       Set Mysubfolder = objNavGroup.NavigationFolders("Prénom Nom - PROSPECTION").Folder.Items
    End If
End If

If Mysubfolder.Count > 0 Then
Mysubfolder.Remove Mysubfolder.Count
DoEvents
End If

Next

End Sub
Rechercher des sujets similaires à "module vba supprimer rendez outlook"