Suprression des rendez-vous Outlook via Vba excel

[MikaTI]

Bonjour à tous,


Je rencontre des difficultés concernant une macro que j’exécute pour gérer les rendez vous d'un calendrier partagé depuis une liste de rendez-vous sur un fichier excel...
Pour l'ajout ok, tout fonctionne.

J'ai besoin d'avoir un module qui supprime tous les rendez vous de ce calendrier partagé...
j'ai un module sur lequel j'ai des bugs...

Il est fonctionnel mais est assez long... et surtout, il me fait "merdouiller" outlook... jusqu'à provoquer sa fermeture...

Je n'arrive pas à voir dans mon code pourquoi...

Je transmets le code ci dessous si quelqu'un aurait une petite idée...

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

 

[Lone-wolf]

Re : Suprression des rendez-vous Outlook via Vba excel

Bonjour MikaTi,

j'ai retrouvé mon projet qui pourrat (je l'éspère) t'aider.

Une fois le classeur ouvert selectionne Jacky de Fontaineblau dans la liste déroulante, clque sur le bouton Rechercher; ensuite double clique dans la listbox et un formulaire viens s'afficher. Clique sur Envoyer et là c'est Outlook qui prend le relais. Pour annuler l'invitation, clique sur l'image "Annuler l'invitation".



A+

 

[MikaTI]

Re : Suprression des rendez-vous Outlook via Vba excel

Bonjour MikaTi,

j'ai retrouvé mon projet qui pourrat (je l'éspère) t'aider.

Une fois le classeur ouvert selectionne Jacky de Fontaineblau dans la liste déroulante, clque sur le bouton Rechercher; ensuite double clique dans la listbox et un formulaire viens s'afficher. Clique sur Envoyer et là c'est Outlook qui prend le relais.



A+

Bonjour

Merci pour votre retour, mais ça ne répond pas à ma demande en fait... bien que votre fichier ait l'air bien...


J'ai absolument besoin d'utiliser mon module, car j'ai mis en place un fichier bien spécifique.... pour du suivi de prospection (date de relance etc)

Le module fonctionne (il m'efface bien tous les rendez vous du calendrier partagé) mais il me fait pleins de bugs sur outlook du coup... (ça rame, je n'arrive plus à répondre à des mails, voire à en afficher, et outlook se ferme au bout d'un moment...)


Merci bien

 

[Lone-wolf]

Re : Suprression des rendez-vous Outlook via Vba excel

Re MikaTi,

essaie d'ajouter ceci pour voir. Mais déjà On Error Resume Next en haut de ta macro et avant End Sub...

Dim Process
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
    If Process.Name = "OUTLOOK.EXE" Then Process.Terminate
Next

A+

 

[MikaTI]

Re : Suprression des rendez-vous Outlook via Vba excel

Re MikaTi,

essaie d'ajouter ceci pour voir. Mais déjà On Error Resume Next en haut de ta macro et avant End Sub...

Dim Process
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
    If Process.Name = "OUTLOOK.EXE" Then Process.Terminate
Next

A+

Avec l'ajout de On Error Resume Next en haut et avant la fin... pas de changement
et en ajoutant ton code... la macro est en cours d'exécution.... (depuis 5 minutes déjà), ça m'a fermé outlook au démarrage de la macro, et là je ne peux plus rien faire ^^, je crois que je vais devoir arrêter le processus manuellement....

 

[MikaTI]

Re : Suprression des rendez-vous Outlook via Vba excel

Re MikaTi,

essaie d'ajouter ceci pour voir. Mais déjà On Error Resume Next en haut de ta macro et avant End Sub...

Dim Process
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
    If Process.Name = "OUTLOOK.EXE" Then Process.Terminate
Next

A+

Je pense que ce qui fait des bugs a outlook c'est la plage de données

For Each Cell In Sheets("RECAP").Range("A2:A1000")

Peut être trop longue?
En fait j'ai fait un test en remplaçant A1000 par A10, et la macro s'est bien exécuté sans faire des bugs sur Outlook... Bon, evidemment, ça ne m'a supprimer que les dates présente jusqu'à la ligne 10...
Peut être indiquer dans la plage, de le faire jusqu'à la dernière ligne remplie...

 

[Lone-wolf]

Re : Suprression des rendez-vous Outlook via Vba excel

Re MikaTi,


Il faut que tu modifie le code comme ceci:

Tu mets une seule adresse comme premier envois et en CC tu mets le reste des adresses si tu envois le même rendez-vous à tous le monde. En CC Max 100 personnes.

Vu que tu as une boucle c'est normal que sa plante surtout si il y a la BDD pour accepter l'enregistrement.

Oubien essaie alors de mettre sous

 If myRecipient.Resolved Then
       Set Mysubfolder = objNavGroup.NavigationFolders("Prénom Nom - PROSPECTION").Folder.Items
    End If
End If

On Error Resume next
If Mysubfolder.Count > 0 Then
Mysubfolder.Remove Mysubfolder.Count
DoEvents
End If
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
    If Process.Name = "OUTLOOK.EXE" Then Process.Terminate
Next

A+

 

[MikaTI]

Re : Suprression des rendez-vous Outlook via Vba excel

Re MikaTi,


Il faut que tu modifie le code comme ceci:

Tu mets une seule adresse comme premier envois et en CC tu mets le reste des adresses si tu envois le même rendez-vous à tous le monde. En CC Max 100 personnes.

Vu que tu as une boucle c'est normal que sa plante surtout si il y a la BDD pour accepter l'enregistrement.

Oubien essaie alors de mettre sous

 If myRecipient.Resolved Then
       Set Mysubfolder = objNavGroup.NavigationFolders("Prénom Nom - PROSPECTION").Folder.Items
    End If
End If

On Error Resume next
If Mysubfolder.Count > 0 Then
Mysubfolder.Remove Mysubfolder.Count
DoEvents
End If
For Each Process In GetObject("winmgmts:").InstancesOf("Win32_process")
    If Process.Name = "OUTLOOK.EXE" Then Process.Terminate
Next

A+

Je suis vraiment désolé... mais ça ne fonctionne pas ^^

Je t'explique en fait le but de mon fichier...

J'ai un fichier excel pour du suivi de prospection...
Le dernier onglet nommé "RECAP", rassemble toutes les lignes des différents onglets du classeur.
Dans ce dossier RECAP j'ai donc un tableau avec plusieurs colonnes dont la dernière contient la date de relance...

J'ai un module vba pour transférer ces dates de relance dans un calendrier outlook partagé.
Ce module VBA fonctionne très très bien.
Seulement, si mon onglet RECAP contient de nouvelles dates, ou si une date de relance est modifiée, lorsque je exécute à nouveau le module pour transférer les dates de relance, ça me créé des nouveaux rendez-vous, sans tenir compte du fait que telle ou telle est ligne a déjà été envoyé, ou que telle ou telle est une modification.


En fait à chaque fois que j'exécute le module pour transférer les rendez-vous, ça ajoute autant de rendez-vous sur outlook...
C'est pour ça que je souhaite exécuter un module, qui va être exécuté avant de transférer les dates, pour supprimer tous les rendez-vous du calendrier partagé... pour ensuite ajouter les dates de l'onglet RECAP

Avant, ce fichier fonctionnait pour un calendrier qui n'était pas partagé (mais dans le groupe "mes calendriers")

C'est depuis peu, que j'ai besoin que ça fonctionne sur un calendrier partagé, car plusieurs personnes vont mettre à jour le fichier excel, et plusieurs personnes accède au calendrier "PROSPECTION" qui est partagé...

 

[Lone-wolf]

Re : Suprression des rendez-vous Outlook via Vba excel

Re MikaTi,

dans ce cas il faut ajouter dans le module de transfert la condition : si date nouvelle est supérieur à date ancienne exit sub ou plus radical End.


A+