[XL-2003] VBA excel envoi automatique par mail

salut,
le mieux aurait été de coller directement le code ici non ? ;)
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
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
Sub EnvoiMessage()
    'JJM - Envoi un message à Outlook, sans l'ouvrir
    'Ajouter la Référence : "Microsoft Outlook XX.X Object Library"
 
    Dim vDestinataires, vCC, vObjet, vMessage, vPJ, vLigne, rc
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem
    Dim cell As Range
    Dim Subj As String
    Dim EmailAddr As String
    Dim Recipient As String
    Dim Bonus As String
    Dim Msg As String
'Stop
    Application.ScreenUpdating = False
    On Error Resume Next
 
    Worksheets("Demo").Activate
 
    'Récup. destinataires
    For Each vLigne In [B7:B16]
        If vLigne <> "" Then vDestinataires = vDestinataires & vLigne & ";"
    Next
 
    'Récup. CC
    For Each vLigne In [C7:C16]
        If vLigne <> "" Then vCC = vCC & vLigne & ";"
    Next
 
    'Récup Objet
    vObjet = Range("B18").Value
 
    'Récup. message, avec sauts de ligne
    For Each vLigne In [B20:B24]
        vMessage = vMessage & vLigne & vbLf
    Next
 
    'Récup. PJ
    vPJ = Range("B26").Value
 
    'Crée l'objet Outlook
    Set OutlookApp = New Outlook.Application
 
    'Création message Outlook et transmission
    Set MItem = OutlookApp.CreateItem(olMailItem)
 
    With MItem
        .To = vDestinataires            'Liste des destinataires
        .CC = vCC                       'Liste des destinataires CC
        .BCC = Range("Demo!D7")         'liste des destinataires CCC
        .Importance = olImportanceHigh  'Importance du message
        .Subject = vObjet               'Objet
        .Body = vMessage                'Texte du message
        .Attachments = vPJ              'Pièce jointe
        .ReadReceiptRequested = True    'Demande de confirmation de lecture
        .Display
    End With
End Sub