Discussion :

[esse2016]

Bonjour,

je n'arrive pas à supprimer le fichier envoyé via outlook. Il bloque par message d'erreur
erreur d'exécution '-2147221238 (8004010a)
erreur automation

sur la ligne NewMail = NewMail.Move(MaPoubelle)

Code :

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

1
2
3
4
5
6
7
8
9
10
 SetOutlookApp = Outlook.Application
 
  Set MyNameSpace = OutlookApp.GetNamespace("MAPI")
  Set MaPoubelle = MyNameSpace.GetDefaultFolder(olFolderDeletedItems)
 
 
NewMail = NewMail.Move(MaPoubelle)
 
 Set NewMail = Nothing
 Set MyNameSpace = Nothing

comment résoudre le problème, SVP ? car le déplacer vers le dossier "deleted items" ne fonctionne pas et du coup l'effacer de ce répertoir je ne sais pas comment faire.

Merci

[joe.levrai]

Bonjour,

qu'est-ce que NewMail ?
est-ce une procédure sous Outlook ? Sur un évènement ?

avec juste ces quelques lignes on ne pourra pas faire grand chose, il faut montrer la procédure complète et nous indiquer sous quelle application elle tourne.

au lieu de localiser le dossier des éléments supprimés pour y déplacer le mail, tu peux également utiliser la méthode .Delete de MailItem

Code :

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

MonMail.Delete

[esse2016]

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
 
Dim MaPoubelle, MonEnvoi As Outlook.Folder
Dim MyNameSpace As Outlook.Namespace
Dim OutlookApp As New Outlook.Application
Dim NewMail    As Object
Dim myDestFolder As Outlook.Folder
Dim myInbox As Outlook.Folder
 
 
 
'**************************CREATION D'ENVOI************************************
Set NewMail = OutlookApp.CreateItem(olMailItem)
 
    'Liste des destinataires
    With NewMail
 
       'Sujet :
       .Subject = "sujet"
       'Copies
       .To = "toto@gmail.com"
 
 
       'Corps du mail :
      NewMail.Body = "Bonjour," & vbCrLf _
    & vbCrLf _
    & "Vous trouverez ci joint le fichier essai.txt" & vbCrLf _
    & vbCrLf _
    & "Cordialement" & vbCrLf _
       '.Attachments.Add ActiveWorkbook.FullName
       .Attachments.Add (ThisWorkbook.Path & "\" & "essai.txt")
       '.Display
       'Envoi :
       .Send
 End With
 'Set NewMail

[esse2016]

NewMail.delete me fait une erreur d'automation, (j'avais déjà essayé)

tant NewMail déclaré comme variable

Dim NewMail As Outlook.MailItem
ou
Dim NewMail As Object

[pijaku]

Bonjour,

A lire : https://msdn.microsoft.com/fr-fr/lib.../ff860683.aspx
(remarque, au vu de tes variables, tu as du le lire)

Voici le code complet :

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
Option Explicit
 
Sub EnvoiEtDeplaceMail()
Dim OutlookApp As New Outlook.Application
Dim MyNameSpace As Outlook.Namespace
Dim MaPoubelle As Outlook.Folder
Dim MessagesEnvoyes As Outlook.Folder
Dim myItems As Outlook.Items
Dim NewMail As Object
Dim myItem As Object
 
'**************************VARIABLES OBJETS************************************
    Set OutlookApp = Outlook.Application
    Set MyNameSpace = OutlookApp.GetNamespace("MAPI")
    Set MaPoubelle = MyNameSpace.GetDefaultFolder(olFolderDeletedItems)
    Set MessagesEnvoyes = MyNameSpace.GetDefaultFolder(olFolderSentMail)
    Set NewMail = OutlookApp.CreateItem(olMailItem)
 
'**************************CREATION D'ENVOI************************************
 
    'Liste des destinataires
    With NewMail
        'Sujet :
        .Subject = "sujet"
        'Copies
        .To = "toto@gmail.com"
 
        'Corps du mail :
        NewMail.Body = "Bonjour," & vbCrLf _
            & vbCrLf _
            & "Vous trouverez ci joint le fichier essai.txt" & vbCrLf _
            & vbCrLf _
            & "Cordialement" & vbCrLf _
       '.Attachments.Add ActiveWorkbook.FullName
       .Attachments.Add (ThisWorkbook.Path & "\" & "Fichier.xml")
       '.Display
       'Envoi :
       .Send
    End With
 
'**************************DEPLACEMENT************************************
    Set myItems = MessagesEnvoyes.Items
    Set myItem = myItems.Find("[Subject] = 'sujet'")
    myItem.Move MaPoubelle
 
'**************************DESTRUCTION OBJETS************************************
    Set myItems = Nothing
    Set myItem = Nothing
    Set NewMail = Nothing
    Set MyNameSpace = Nothing
    Set MessagesEnvoyes = Nothing
    Set MaPoubelle = Nothing
End Sub

[esse2016]

Re,

En appliquant cette méthode avec la déclaration:
NewMail.DeleteAfterSubmit = True avant le "with Newmail"

cela supprime du dossier "Sent Items" et du "deleted Items"

Merci.

[Oliv-]

Bonjour,
tu aurais du préciser quand se déclenchait ta macro (Application_ItemSend ou .send)

[esse2016]

Désolé, Oliv, n'étant pas un expert...

Mais dans tous les cas, merci pour vos interventions, car c'est du bénévolat de votre part.