Discussion :

[Djohn]

Bonjour,


Dans mon petit code d'envoi de mail en VBA, j'aimerai changer l’expéditeur qui est mon edresse personnelle par l'adresse générique de mon service. (je précise que cela fonctionne lorsque j'envoie un message normalement directement sur Outlook)

J'ai donc rajouter From (malheureusement dans la case expéditeur j'ai toujours mon adresse)

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
    Dim OutApp As Object
    Dim OutMail As Object
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .From = "adressedeservice@masociete.fr"
        .To = adr1 & ";" & adr2 & ";" & adr3 & ";" & adr4 & ";" & adr5 & ";" & adr6 & ";" & adr7 & ";" & adr8
        .Subject = "données quotidiennes"
        .Attachments.Add CheminSource & FichierSource
        .body = "Veuillez trouver les informations en pièces jointes"
 
        .Send
        .Display
    End With
    On Error GoTo 0
 
    Set OutMail = Nothing
    Set OutApp = Nothing

Auriez vous une solution à me proposer

merci

[Invité]

Bonjour,
Outlook utilise le compte actif, je ne pense pas que ce soit possible.
Regarde ce poste et regarde si ça répond à ta question.

http://www.developpez.net/forums/d13...l-thunderbird/

[Djohn]

Bonjour rdurupt,
je n'ai rien trouvé de probant dans ton lien.
Je vais esaayer de mieux chercher sur Google.
Merci

[Invité]

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
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
100
101
102
103
104
105
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
const SSL=false
'Delivery Status Notifications
Const cdoDSNDefault = 0 'None
Const cdoDSNNever = 1 'None
Const cdoDSNFailure = 2 'Failure
Const cdoDSNSuccess = 4 'Success
Const cdoDSNDelay = 8 'Delay
Const cdoDSNSuccessFailOrDelay = 14 'Success, failure or delay
 
const Serveur="MyServeur"
const User="MyUser"
const PassWord="MyPassWord"
const Port=25 
const Delay=10
const Expediteur="MyExpediteur@MyEbergeur.fr"
const Dest="MyDest@MyEbergeur.fr"
const DestEnCopy="MyDestEnCopy@MyEbergeur.fr"
const DestEnCopyCaher="MyDestEnCopyCaher@MyEbergeur.fr"
const Objet="Je te parle de:"
const Body= "Je vous parle d’un temps que les moins de vingt  ans ne peuvent pas connaître"
'const Pj="c:\Pièce_jointe.PDF"
const Pj=""
EnvoiMailSmtp Serveur, cdoAnonymous,SSL,User,PassWord,Port , Delay,cdoDSNDefault, Expediteur, Dest, DestEnCopy, Objet,Body,Pj
'**************************************************************************************************************************************************************************************************************
Public Sub MailEnvoi(Serveur, Identify , SSL, User, PassWord, Port, Delay,cdoDSN, Expediteur, Dest, DestEnCopy,DestEnCopyCaher, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim splitPj
Dim IsplitPj 
dim schema
 
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") '  pour la configuration de l'envoi
Dim strHTML
 
Set Config = Conf.Fields
 
' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
schema = "http://schemas.microsoft.com/cdo/configuration/" 'smtpusessl
With Config
 
If Identify <> 0 Then 
    .Item(schema & "smtpusessl") =SSL
    .Item(schema & "smtpusetls") = 1
    .Item(schema & "smtpauthenticate") = Identify 
    .Item(schema & "sendusername") = User
    .Item(schema & "sendpassword") = PassWord
end if
    .Item(schema & "smtpserverport") = Port
    .Item(schema & "sendusing") = 2
    .Item(schema & "smtpserver") = Serveur
    .Item(schema & "smtpconnectiontimeout") = Delay
    .Item(schema & "enablessl") = 1
    .Update
End With
 
 
 
'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1
 
With msg
    Set .Configuration = Conf
    .To = Dest
    .cc = DestEnCopy
    .bcc= Expediteur & ";" & DestEnCopyCaher
    .bcc=DestEnCopyCaher
    .FROM = Expediteur
    .Subject = Objet
    .DSNOptions = cdoDSN
'
 
    .htmlbody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
            If Pj <> "" Then
        splitPj = Split(Pj & ";", ";")
 
        For IsplitPj = 0 To UBound(splitPj)
            If Trim("" & splitPj(IsplitPj)) <> "" Then
                .AddAttachment Trim("" & splitPj(IsplitPj))
            End If
        Next
 
    End If
	on error resume next
    .Send 'envoi du message
	if err<>0 then
		msgbox err.description
	else
		msgbox "Fin"
	end if
 
End With
 
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
 
End Sub

[Djohn]

pour etre sincere je ne comprends que partiellement ton code.

Cependant j'ai trouvé une solution sur un autre site. :

je remplace ma ligne

Code :

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

.From = "adressedeservice@masociete.fr"

par

Code :

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

.SentOnBehalfOfName = "adressedeservice@masociete.fr"

si ça peut aider quelqu'un d'autre