Discussion :

[neiluj26]

Bonjour le forum,

Sur le bouton "Envoyer" d'un formulaire, j'ai écrit le code suivant:

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
Private Sub cmdEnvoyer_Click()
 
'------ Envoi du mail avec la méthode CDO
On Error GoTo DeuxiemeEssai
Dim Sourcewb As Workbook, Destwb As Workbook
Dim Temp As String, CdoMessage As Object, Fichier As String
 
    Set Sourcewb = ActiveWorkbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    Temp = ThisWorkbook.Path & Application.PathSeparator & "Recap " & Format(Date, "ddmmyyyy") & ".xls"
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
 
    Destwb.SaveAs Temp
    Fichier = Destwb.Path & Application.PathSeparator & Destwb.Name
    Destwb.Close
    Application.DisplayAlerts = True
 
    Set CdoMessage = CreateObject("CDO.Message")
    With CdoMessage
        .Subject = "Récap " & Format(Date, "ddmmyyyy")
        .To = "toto@yyyy.com; tata@yyyy.com"
        .TextBody = "Veuillez trouver ci-joint notre récapitulatif en date du " & Format(Date, "ddmmyyyy")
        .AddAttachment Fichier
        .Send
    End With
 
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Set CdoMessage = Nothing
    Kill Fichier
 
DeuxiemeEssai: EnvoyerParSendMail
Exit Sub
End Sub
 
Private Sub EnvoyerParSendMail()
'------ Envoi avec la méthode sendmail si la méthode CDO ne fonctionne pas.
On Error GoTo GestionErreur
    strSujetMail = "Récap " & Format(Date, "ddmmyyyy")
    strDestinataires(0) = "toto@yyyy.com": strDestinataires(1) = "tata@yyyy.com"
    ActiveWorkbook.SendMail strDestinataires, strSujetMail, False
 
GestionErreur:    MsgBox strErreurEnvoiMail
 
End Sub

Le but est d'envoyer automatiquement le fichier actif a deux adresses fixes. Je ne suis pas sûr que mes utilisateurs disposent tous d'Outlook. Pour contourner le problème, et comme je n'ai besoin que de la première feuille, j'essaie déjà avec la méthode CDO. Si elle ne fonctionne pas (si l'adresse du serveur SMTP est nécessaire par exemple), j'essaie avec la méthode SendMail.
Si il y a une erreur, je veux afficher une msgbox qui demande à l'utilisateur d'envoyer lui-même le fichier.

Code :

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

MsgBox strErreurEnvoiMail

Sur mon poste, la méthode CDO ne fonctionne pas et je n'ai pas l'adresse de mon serveur SMTP. La routine essaie donc avec la méthode SendMail. Le mail part bien, mais à chaque fois, la MsgBox apparaît. J'imagine que c'est un problème de gestion des erreurs?

[neiluj26]

Bon, en relisant mon code, je l'ai grandement simplifié et j'ai supprimé la partie où j'essayais d'envoyer par CDO (je le faisais parce que je voulais envoyer la première feuille seulement...).

Voici ce qu'il donne maintenant:

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
On Error GoTo GestionErreur
 
Dim Sourcewb As Workbook, Destwb As Workbook, Temp As String
Set Sourcewb = ActiveWorkbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
 
Temp = ThisWorkbook.Path & Application.PathSeparator & "Récap " & Format(Date, "ddmmyyyy") & ".xls"
 
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
 
Destwb.SaveAs Filename:=Temp, FileFormat:=xlExcel8
'------ Envoi du mail avec la méthode SendMail .
strSujetMail = "Récap " & Format(Date, "ddmmyyyy")
strDestinataires(0) = "toto@yyyy.com": strDestinataires(1) = "tata@yyyy.com"
Destwb.SendMail strDestinataires, strSujetMail, False
 
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
Destwb.Close SaveChanges:=False
Kill Temp
 
GestionErreur:  MsgBox strErreurEnvoiMail
End Sub

Mais malheureusement, la MsgBox s'affiche encore à chaque fois.

[mayekeul]

bonjour,

tu dois ajouter

Code :

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

Exit Sub

avant ton gestionnaire d'erreur

Code :

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

GestionErreur:  MsgBox strErreurEnvoiMail

[neiluj26]

Effectivement, c'était ça. Merci! Tout fonctionne bien maintenant.