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
| Sub EnvoyerEmail(ByVal Sujet As String, ByVal Destinataire As String, ByVal ContenuEmail As String, Optional ByVal PieceJointe As String)
On Error GoTo EnvoyerEmailErreur
'd?finition des variables
Dim oOutlook As Outlook.Application
Dim oMailItem As Outlook.MailItem
Dim Body As Variant
Body = ContenuEmail
'v?rification si le Contenu du mail n'est pas vide. Si oui, email n'est pas envoy?. Si vous voulez pouvoir envoyer les email vides, mettez en commentaire les 4 lignes de code qui suivent.
If (Body = False) Then
MsgBox "Mail non envoy? car vide", vbOKOnly, "Message"
Exit Sub
End If
'pr?parer Outlook
PreparerOutlook oOutlook
Set oMailItem = oOutlook.CreateItem(0)
'cr?ation de l'email
With oMailItem
.To = Destinataire
.Subject = Sujet
.BodyFormat = olFormatRichText
.Body = Body
If PieceJointe <> "" Then
.Attachments.Add PieceJointe
End If
.Display '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
.Save '<- sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire)
.Send '<- envoie l'email (si vous voulez seulement pr?parer l'email et l'envoyer manuellement, mettez cette ligne en commentaire)
End With
'nettoyage...
If (Not (oMailItem Is Nothing)) Then
Set oMailItem = Nothing
End If
If (Not (oOutlook Is Nothing)) Then
Set oOutlook = Nothing
End If
Exit Sub
EnvoyerEmailErreur:
If (Not (oMailItem Is Nothing)) Then
Set oMailItem = Nothing
End If
If (Not (oOutlook Is Nothing)) Then
Set oOutlook = Nothing
End If
MsgBox "Le mail n'a pas pu ?tre envoy?...", vbCritical, "Erreur"
End Sub
Private Sub PreparerOutlook(ByRef oOutlook As Object)
On Error Resume Next
'v?rification si Outlook est ouvert
Set oOutlook = GetObject(, "Outlook.Application")
If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, on l'ouvre
Err.Clear
Set oOutlook = CreateObject("Outlook.Application")
If (Err.Number <> 0) Then
MsgBox "Une erreur est survenue lors de l'ouverture de Outlook..."
Exit Sub
Else
End If
Else 'si Outlook est ouvert, l'instance existante est utilis?e
End If
End Sub |
