gestion d'erreur

zaid

XLDnaute Nouveau
Bonjour à tous,

Je voudrais savoir si quelqu'un peut m'aider à creer une gestion d'erreur (on error) pour le code suivant pour eviter les problemes aves les mails qui ne sont pas valide, ou absence d'adresse mail

le code:

Private Sub CommandButton1_Click()
Dim MonOutlook As Object
Dim MonMessage As Object
Dim corps As String


nomNewClasseur = Range("M4") & "-" & Format(Now(), "ddmmyy") & ".pdf"
répertoireAppli = ActiveWorkbook.Path
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
répertoireAppli & "\envois\" & nomNewClasseur, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
MonMessage.To = Range("p2").Value 'Saisir l'adresse mail
MonMessage.Subject = Range("B24").Value
corps = "Bonjour ," & Chr(13) & Chr(13) & "Prière de trouver ci-joint votre relevé de pointage." & Chr(13) & Chr(13) & "Meilleures salutations," & Chr(13) & Chr(13) & "A. ZAID" & Chr(13) & Chr(13) & "HOTEL ROYAL ELYSEES" & Chr(13) & "Tél.: 01 45 00 05 57" & Chr(13) & "zaid@royal-elysees.com"

MonMessage.Attachments.Add répertoireAppli & "\envois\" & nomNewClasseur
MonMessage.Body = corps
MonMessage.send
Set MonOutlook = Nothing
Set MonMessage = Nothing


End Sub


merci beaucoup
 

DoubleZero

XLDnaute Barbatruc
Re : gestion d'erreur

Bonjour, zaid, le Forum,

Peut-être ainsi :

VB:
Private Sub CommandButton1_Click()
Dim MonOutlook As Object
Dim MonMessage As Object
Dim corps As String

On Error GoTo fin
nomNewClasseur = Range("M4") & "-" & Format(Now(), "ddmmyy") & ".pdf"
répertoireAppli = ActiveWorkbook.Path
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
répertoireAppli & "\envois\" & nomNewClasseur, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
MonMessage.To = Range("p2").Value 'Saisir l'adresse mail
MonMessage.Subject = Range("B24").Value
corps = "Bonjour ," & Chr(13) & Chr(13) & "Prière de trouver ci-joint votre relevé de pointage." & Chr(13) & Chr(13) & "Meilleures salutations," & Chr(13) & Chr(13) & "A. ZAID" & Chr(13) & Chr(13) & "HOTEL ROYAL ELYSEES" & Chr(13) & "Tél.: 01 45 00 05 57" & Chr(13) & "zaid@royal-elysees.com"

MonMessage.Attachments.Add répertoireAppli & "\envois\" & nomNewClasseur
MonMessage.Body = corps
MonMessage.send
Set MonOutlook = Nothing
Set MonMessage = Nothing
Exit Sub

fin:
MsgBox "Le message ne peut être envoyé !"
End Sub

A bientôt :)
 

Discussions similaires

Réponses
4
Affichages
8 K

Statistiques des forums

Discussions
312 103
Messages
2 085 319
Membres
102 862
dernier inscrit
Emma35400