VBA Envoi de mail avec réponse si correct

Version imprimable

Bonjour,
j'arrive à envoyer un mail avec Excel via Outlook mais je souhaite avoir d'autres éléments :
- Savoir si l'adresse était bonne
- Détruire le mail dans le dossier "Envoyés" d'Outlook

Merci d'avance.

Mon code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Set Email = CreateObject("Outlook.Application")
Set EmailMsg = Email.CreateItem(olMailItem)
Dim Corps_message ' Corps du message
Corps_message = " Ceci est un mail généré de façon automatique"
EmailMsg.To = Feuil1.Cells(num_ligne, 1)
EmailMsg.Subject = "Essai de mail par Excel " & Feuil1.Cells(num_ligne, 1)
EmailMsg.Body = Corps_message
EmailMsg.Send
 
EmailMsg.DeleteAfterSubmit = True 'ici de je souhaite détruire le mail dans le dossier Envoyés !
EmailMsg.Error : Feuil1.Cells(num_ligne, 3) = "KO" 'ici de je souhaite avoir KO si le mail n'est pas envoyé !
 
EmailMsg.Error ' Message d'erreur
On Error GoTo errorHandler
Exit Sub
Set EmailMsg = Nothing
Set Email = Nothing
errorHandler: MsgBox ("ERREUR")
 
End Sub

01/10/2014, 12h12
Jean-Philippe André

Salut,

peux-tu préciser ce que tu entends par "adresse bonne" stp ? Est-ce une adresse mail valide (de type a@b.c) ou que l'adresse mail est valide ?

Exemple dans la :faq:
http://outlook.developpez.com/faq/?p...Existe_Contact

Pour la suppression une fois le mail envoyé, tu as des pistes dans la :faq:
http://outlook.developpez.com/faq/?p...A_Deplace_mail

bonne lecture :)

Bonjour jpcheck,

j'ai le message d'erreur : type défini par l'utilisateur non défini

le code complet :

Code:

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
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As _
Boolean)
 'By Oliv' 9/02/2007 pour Outlook 2003
If Not Item.Class = olMail Then GoTo fin
    Dim objNS As Namespace
    Dim objFolder As MAPIFolder
    Set objNS = Application.GetNamespace("MAPI")
    Set objFolder = objNS.PickFolder
    If TypeName(objFolder) = "Nothing" Then
    Set objNS = Application.GetNamespace("MAPI")
    Set objFolder = objNS.Folders("Boîte de réception").Folders("Éléments supprimés")
    End If
    Set Item.SaveSentMessageFolder = objFolder
fin:
End Sub
Sub essai()
Set Email = CreateObject("Outlook.Application")
Set EmailMsg = Email.CreateItem(olMailItem)
Dim Corps_message ' Corps du message
Corps_message = " Ceci est un mail généré de façon automatique"
EmailMsg.To = "moi.@adresse.fr"
EmailMsg.Subject = "Essai de mail par Excel "
EmailMsg.Body = Corps_message
EmailMsg.Send
' EmailMsg.DeleteAfterSubmit = True 'ici de je souhaite détruire le mail dans le dossier Envoyés !
' EmailMsg.Error: Feuil1.Cells(num_ligne, 3) = "KO"  'ici de je souhaite avoir KO si le mail n'est pas envoyé !
' EmailMsg.Error ' Message d'erreur
' On Error GoTo errorHandler
' Exit Sub
Set EmailMsg = Nothing
Set Email = Nothing
' errorHandler: MsgBox ("ERREUR")
End Sub

J'ai trouvé comment faire pour ne pas avoir le message dans le dossier Envoyés :

il fallait mettre la ligne au bon endroit :

Code:

1
2
3
 
EmailMsg.DeleteAfterSubmit = True
EmailMsg.Send

il ne me reste plus qu'à trouver comment faire pour qu'Outlook me réponde s'il ne trouve pas l'adresse dans mon annuaire local !

C'est bon !
il faut mettre la gestion d'erreur au bon endroit !

Voici le code corrigé :

Code:

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
 
Set Email = CreateObject("Outlook.Application")
Set EmailMsg = Email.CreateItem(olMailItem)
 
On Error GoTo errorHandler 'ici la gestion des erreurs !
 
Dim Corps_message ' Corps du message
Corps_message = " Ceci est un mail généré de façon automatique"
EmailMsg.To = Feuil1.Cells(num_ligne, 1)
EmailMsg.Subject = "Essai de mail par Excel " & Feuil1.Cells(num_ligne, 1) 'le mail est dans la colonne 1
EmailMsg.Body = Corps_message
EmailMsg.Send
 
EmailMsg.DeleteAfterSubmit = True 'ici de je souhaite détruire le mail dans le dossier Envoyés !
 
 
Exit Sub ' si tout est ok !
 
Set EmailMsg = Nothing
Set Email = Nothing
 
errorHandler: 'ici le message d erreur !
Feuil1.Cells(num_ligne, 3) = "KO" 'ici de je souhaite avoir KO si le mail n'est pas envoyé !
 
 
End Sub