Modification d'une macro pour spécifier l'adresse de l'expéditeur.

[Bernard67]

Bonjour le forum,

Je cherche de l'aide pour modifier cette macro, afin de definir l'expediteur.
J'envoie des fichiers à partir de différents PC, et je souhaite que ces envois se fassent avec mon adresse mail comme expediteur, ainsi les retours arriveraient directement sur mon poste. Je ne peux pas modifier l'adresse des messages entrants des autres PC, car tous les messages de mes collegues arriveraient sur mon PC.
C'est par outlook 2003. Je vous remercie pour votre aide.

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Sub envoi_mail()
 
    envoi = 0
    Sheets("Intro").Range("E8").Value = ""
 
    'Mettre "ok" ligne 8 colonne 4 sinon le MsgBox s'affiche
    If Sheets("Liste_des_messages").Cells(8, 4) = "" Then
        MsgBox "Veuillez d'abord valider que les fiches sont bien à la bonne date, colonne E"
        Exit Sub
    End If
 
 
    ' k represente le nombre de message à envoyer
    For k = 0 To 1000
 
        ' si la cellule Cells(k + 2, 2) est vide, on arrete
        If Sheets("Liste_des_messages").Cells(k + 2, 2) = "" Then
            Exit For
        End If
 
    Next k
 
    ' on réinitialise l'affichage de l'avancement
    Sheets("Intro").Range("D12").Value = "Envoi du mail 0 / 0"
    Sheets("Intro").Range("D13").Value = "messages envoyés : 0"
 
 
    'pour toute les valeurs de k :
    For i = 2 To k + 1
 
        'affichage
        Sheets("Intro").Range("D12").Value = "Envoi du mail " & i - 1 & " / " & k
 
        'on crée 2 objets
        Dim ol As Object, NOUVEAU_MESSAGE As Object
        Dim strBody As String
        'ol contient les fonctions d'outlook
        Set ol = CreateObject("outlook.application")
        'on crée une instance (la voiture) à partir du modèle : en informatique la 'class' d'un mail (le shema de la voiture)
        Set NOUVEAU_MESSAGE = ol.CreateItem(olMailItem)
 
        titre_mail = Sheets("Liste_des_messages").Cells(i, 4)
        courriel_to = Sheets("Liste_des_messages").Cells(i, 2)
        courriel_cc = Sheets("Liste_des_messages").Cells(i, 3)
 
        corps_mail = Cells(i, 5) & Chr(10)
        corps_mail = corps_mail & "Bonjour," & Chr(10) & Chr(10)
        corps_mail = corps_mail & "Veuillez trouver ci-joint le fichier du Mois, indiqué en colonne E." & Chr(10) & Chr(10) & Chr(10)
        corps_mail = corps_mail & "Cordialement," & Chr(10) & Chr(10)
        corps_mail = corps_mail & "Bernard, Tel:06-01-02-03-04-05, NASA." & Chr(10) & Chr(10) & Chr(10)
        corps_mail = corps_mail & "Piece(s) jointe(s) :" & Chr(10) & Chr(10)
 
        NOUVEAU_MESSAGE.To = courriel_to
        NOUVEAU_MESSAGE.Subject = titre_mail
        NOUVEAU_MESSAGE.cc = courriel_cc
        NOUVEAU_MESSAGE.Body = corps_mail
 
 
        j = 6
        'rappel : nous sommes dans une boucle qui s'execute pour chaque ligne
        'dans la ligne, on verifie que Fichier existe
        For j = 6 To 20
 
            If Sheets("Liste_des_messages").Cells(i, j) = "" Then
                Exit For
            End If
 
            On Error Resume Next
    'Ne pas oublier les 2 \\ en debut et a la fin \ sur PC domicile pas de \\
 
            NOUVEAU_MESSAGE.Attachments.Add "E:\Mes documents\TEST\Fichiers\" & Sheets("Liste_des_messages").Cells(i, j) & ".xls"
            On Error GoTo 0
 
        Next j
 
        'si Fichiers existe :
        If j <> 6 Then
 
            'on incrémente (ajouter 1) le compteur d'envoi
            envoi = envoi + 1
            Sheets("Intro").Range("D13").Value = "messages envoyés : " & envoi
 
            'on affiche le message
            NOUVEAU_MESSAGE.Display
            Application.Wait (Now + TimeValue("00:00:02"))
 
            'on clique sur "entrer"
            SendKeys "^{ENTER}", True
            Application.Wait (Now + TimeValue("00:00:04"))
 
            'on detruit notre message dans la mémoire vive
            Set ol = Nothing
            Set NOUVEAU_MESSAGE = Nothing
        End If
 
    Next i
 
 
End Sub

[Oliv-]

Salut,
Le plus simple c'est d'utiliser CDO voir ex:
http://www.developpez.net/forums/sho...&highlight=cdo