Discussion :

[Aero31]

Bonjour,

J'essaie depuis plusieurs heures de comprendre pourquoi j'ai toujours le même message d'erreur "L'élément a été déplacé ou supprimé" à la ligne 70 lors de l'exécution de la macro ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
'            'Original function written by Diane Poremsky: http://www.slipstick.com/developer/send-email-outlook-reminders-fires/
'
'            Private Sub Application_Reminder(ByVal Item As Object)
'              Dim objMsg As MailItem
'              Set objMsg = Application.CreateItem(olMailItem)
'            If Item.MessageClass <> "IPM.Appointment" Then 'vérifie s'il s'agit d'un rappel sur RDV
'              Exit Sub
'            End If
'            If Item.Categories <> "Mails automatiques" Then 'indiquer ici le nom de la catégorie créée pour les mails autos
'              Exit Sub
'            End If
'              objMsg.SendUsingAccount = objMsg.Session.Accounts.Item(1) 'si gestion de plusieurs comptes
'              objMsg.Importance = olImportanceHigh 'importance du message
'              objMsg.To = Item.Location 'ligne Lieu de rendez-vous utilisée pour les adresses
'              objMsg.Subject = Item.Subject 'objet du mail
'              objMsg.Body = Item.Body 'corps du mail
'              objMsg.Attachments.Add "C:\Users\xxx\Desktop\xxx.jpg" 'pour ajouter une pièce jointe
'               objMsg.Send 'DISPLAY : affiche le mail avant envoi - SEND : envoit le mail sans relecture
'              Set objMsg = Nothing
'            End Sub
'
 
 
'Original function written by Diane Poremsky: http://www.slipstick.com/developer/send-email-outlook-reminders-fires/
 
Private Sub Application_Reminder(ByVal Item As Object)
  Dim objMsg As MailItem
  Set objMsg = Application.CreateItem(olMailItem)
 
 
' ----------- Airbus 360 Degree review with Girish :
 
If Item.MessageClass <> "IPM.Appointment" Then 'vérifie s'il s'agit d'un rappel sur RDV
  Exit Sub
End If
If Item.Categories = "Reminder inputs for Airbus 360 degree review" Then 'indiquer ici le nom de la catégorie créée pour les mails autos
'  objMsg.SendUsingAccount = objMsg.Session.Accounts.Item(1) 'si gestion de plusieurs comptes
  objMsg.Importance = olImportanceHigh 'importance du message
  objMsg.To = Item.Location 'ligne Lieu de rendez-vous utilisée pour les adresses
  objMsg.Subject = Item.Subject 'objet du mail
  objMsg.Body = Item.Body 'corps du mail
'  objMsg.Attachments.Add "C:\Users\xxx\Desktop\xxx.jpg" 'pour ajouter une pièce jointe
  objMsg.Send 'DISPLAY : affiche le mail avant envoi - SEND : envoit le mail sans relecture
'  objMsg.Attachments.Add "C:\Users\Patrick DUBERNET\Desktop\DocPourMAilsAuto\Vertical_Bundle_Monthly_Steering.pptx"
 
' ----------- Airbus Weekly Meeting review with Sandrine :
 
ElseIf Item.Categories = "Reminder inputs for Customer Weekly Meeting review" Then 'indiquer ici le nom de la catégorie créée pour les mails autos
 
 
'  objMsg.SendUsingAccount = objMsg.Session.Accounts.Item(1) 'si gestion de plusieurs comptes
  objMsg.Importance = olImportanceHigh 'importance du message
  objMsg.To = Item.Location 'ligne Lieu de rendez-vous utilisée pour les adresses
  objMsg.Subject = Item.Subject 'objet du mail
  objMsg.Body = Item.Body 'corps du mail
'  objMsg.Attachments.Add "C:\Users\xxx\Desktop\xxx.jpg" 'pour ajouter une pièce jointe
  objMsg.Send 'DISPLAY : affiche le mail avant envoi - SEND : envoit le mail sans relecture
'  objMsg.Attachments.Add "C:\Users\Patrick DUBERNET\Desktop\DocPourMAilsAuto\Vertical_Bundle_Monthly_Steering.pptx"
 
ElseIf Item.Categories = "Mails automatiques" Then 'indiquer ici le nom de la catégorie créée pour les mails autos
 
 
'  objMsg.SendUsingAccount = objMsg.Session.Accounts.Item(1) 'si gestion de plusieurs comptes
'  objMsg.Importance = olImportanceHigh 'importance du message
  objMsg.To = Item.Location 'ligne Lieu de rendez-vous utilisée pour les adresses
  objMsg.Subject = Item.Subject 'objet du mail
  objMsg.Body = Item.Body 'corps du mail
'  objMsg.Attachments.Add "C:\Users\xxx\Desktop\xxx.jpg" 'pour ajouter une pièce jointe
  objMsg.Send 'DISPLAY : affiche le mail avant envoi - SEND : envoit le mail sans relecture
  objMsg.Attachments.Add "c:\\CKINFO.TXT"
 
Exit Sub
 
End If
 
  Set objMsg = Nothing
End Sub
 
 
 
'Mails automatiques

Est-ce que quelqu'un pourrait m'aider ?
Merci à vous tous et toutes
Cordialement,
Aero31

[Oliv-]

Bonjour,
Parce que tu envois le mail (.send) avant d'ajouter la pj (attachments.add)

[Aero31]

Bonjour Oliv-

Ah ben oui c'est évident en plus .... j’avais pas vu la poutre que j'avais dans l’œil

Je teste et clôture au plus vite

Merci Oliv- !
Cordialement,
Aero 31

[gregaury5252]

Bonjour,

Pour ma part, ça ne fonctionne du tout...