Comment changer l'expéditeur d'un e-mail en VBA?
Bonjour,
J'utilise la fonction ci-dessous pour envoyer des e-mails à partir d'un tableau Excel. L'opération s'effectue en entreprise mais à partir de mon poste de travail sur lequel deux comptes (boîtes aux lettres) sont configurés : ma boîte e-mail personnelle et une boîte e-mail générique du département.
Lorsque j'envoi des e-mails l'expéditeur est toujours mon adresse perso alors que je précise dans la fonction .Sender l'adresse de la boîte générique. J'ai utilisé aussi la fonction .SendUsingAccount mais le résultat est le même.
Comment puis-je forcer à ce que le message soit envoyé par cette adresse générique et non la mienne?
Merci d'avance pour toute aide.
Sub EnvoiEmailGenerique()
Dim Olk As Object, Omail As Object
On Error Resume Next
Set Olk = GetObject(, "Outlook.Application")
On Error GoTo 0
If Olk Is Nothing Then Set Olk = CreateObject("Outlook.Application")
Set Omail = Olk.CreateItem(olMailItem)
With Omail
.Sender = "msgboxstandardEntreprise@entr.fr"
.To = "Cheicknaxyz@yahoo.fr"
.CC = "cheicknaxyz@yahoo.fr"
.Subject = "Test d'envoi de message"
.Body = "Bienvenue à vous"
.display
End With
Set Omail = Nothing
Set Olk = Nothing
End SubBonjour,
En utilisant la fonction .SentOnBehalfOfName, le message est bien envoyé par la boîte générique de l'entreprise et non par ma boîte personnelle. Il reste néanmoins un petit problème : Le message apparait dans les éléments envoyés de ma boîte perso et non dans les éléments envoyés de la boite générique. Certainement parce qu'en utilisant On Behalf of on envoi le message de la part d'une personne mais pas que la personne elle même a envoyé le message. Malgré tout, lorsqu'on fait répondre le message est bien envoyé à l'adresse générique, ce que je souhaite. Le problème reste donc de gérer les éléments envoyés.
Une idée ?
Merci d'avance
Bonjour à toutes et à tous,
Je n'ai toujours pas trouvé de solution à ce problème après avoir utiliser les 3 propriétés disponible de l'Objet MailItem .Sender, .SendUsingAccount et .SentOnBehalfOfName (cf. code ci-dessous). J'ai même utilisé les 3 méthodes en même temps sans succès.
Sub EnvoiEmailGenerique()
Dim strEmailSender As String
Dim Olk As Object, Omail As Object
On Error Resume Next
Set Olk = GetObject(, "Outlook.Application")
On Error GoTo 0
If Olk Is Nothing Then Set Olk = CreateObject("Outlook.Application")
Set Omail = Olk.CreateItem(olMailItem)
With Omail
.Sender = "Dptachat@yahoo.fr"
.SendUsingAccount = "Dptachat@yahoo.fr"
.SentOnBehalfOfName = "Dptachat@yahoo.fr"
.To = "Cheickna98568@gmail.com"
.CC = ""
.Subject = "Récapitulatif hebdomadaire"
.Body = "Bonjour, rien à signaler cette semaine si ce n'est cette fonction qui ne marche pas"
.Omail.display 'ou Omail.send
End With
Set Omail = Nothing
Set Olk = Nothing
End SubJe réexplique le contexte avec quelques contraintes.
Sur mon PC professionnel j'ai deux comptes e-mails configurés représentés dans mon code par des adresses fictives suivantes : Dptachat@yahoo.fr et Cheickna98568@gmail.com (Boîte au lettres par défaut : qui doit obligatoirement rester par défaut - contrainte de l'entreprise)
Je veux que par VBA certains messages soient envoyés par Dptachat@yahoo.fr et non par mon compte par défaut. Ce qui marche très bien avec mon code. Lorsque les destinataires des messages font Répondre c'est bien l'adresse Dptachat@yahoo.fr qui reçoit, donc tout va bien.
Seul problème : Les messages envoyés se retrouvent dans les éléments envoyés de l'adresse par défaut (Cheickna98568@gmail.com) et non dans les éléments envoyés de Dptachat@yahoo.fr. On ne peut donc plus tracer les mails envoyés par cette boîte. De mon point de vu cela pourrait provenir du fait que c'est parce que Dptachat@yahoo.fr n'est pas l'adresse par défaut mon PC.
Question: Une proposition probablement tordue je l'avoue que j'envisage serait d'écrire une fonction qui déplacerait un e-mail depuis les éléments envoyés d'une boîte aux lettres vers le dossier éléments envoyés d'une autre boîte aux lettres, dans mon cas de la boîte Cheickna98568@gmail.com vers la boîte Dptachat@yahoo.fr. Est-ce possible et surtout cela n'est-il pas du bidouillage ?
Merci d'avance pour vos lumières.
Bonjour,
Vous pouvez utiliser la propriété .BCC (.cci) pour mettre en copie cachée votre seconde adresse mail :
Sub EnvoiEmailGenerique()
Dim strEmailSender As String
Dim Olk As Object, Omail As Object
On Error Resume Next
Set Olk = GetObject(, "Outlook.Application")
On Error GoTo 0
If Olk Is Nothing Then Set Olk = CreateObject("Outlook.Application")
Set Omail = Olk.CreateItem(olMailItem)
With Omail
.SentOnBehalfOfName = "Dptachat@yahoo.fr"
.To = "Cheickna98568@gmail.com"
.BCC = "Dptachat@yahoo.fr"
.Subject = "Récapitulatif hebdomadaire"
.Body = "Bonjour, rien à signaler cette semaine si ce n'est cette fonction qui ne marche pas"
.Omail.display 'ou Omail.send
End With
Set Omail = Nothing
Set Olk = Nothing
End SubDe cette manière, vous gardez copie des mails envoyés sur les 2 boites normalement.
Cdlt,
Bonjour 3GB,
Merci beaucoup pour votre message. C'est effectivement ce que j'ai déjà en fait en utilisant .To = "Cheickna98568@gmail.com; Dptachat@yahoo.fr" au lieu de .BCC car le résultat est le même. Mais cela ne convient pas car le massage apparait dans la boîte de réception du compte Dptachat@yahoo.fr et non dans sa boîte "Eléments envoyés". Cela reste perturbant car les éléments de la boîte de réception sont traités automatiquement par des règles mises en place par l'entreprise. Si je mets mes messages je dois nous devons définir de nouvelles règles pour reconnaitre tous mes messages spécifiques et ne pas les traiter quand ils arriveront dans cette boite de réception de la BAL entreprise.
Encore merci
Re cheickna,
Justement, j'y songeais et ça me semble être une bonne idée, la plus simple, si réalisable : créer une règle pour déplacer ce courrier vers les messages envoyés. Cette règle pourrait dépendre du libellé de l'objet ou de l'adresse de l'expéditeur qui doit bien demeurer Dptachat@yahoo.fr j'imagine.
Sinon, il faudrait essayer d'inspecter les possibilités de l'application Outlook mais ce n'est pas garanti que ce soit faisable aisément...
Cdlt,
si vous avez accès à tous les 2 emailaddresses, vous pouvez deplacer ce mail de votre "Folder" "Messages envoyés" vers le Folder de tous. Cela n'est pas possible directement, parce que il y a un delai au niveau Outlook, certainement quand vous utilisez "display", mais de temps en temps et alors vous pouvez tester par example le subject ...
par example, http://www.snb-vba.eu/VBA_Outlook_external_en.html#L_5.2.2
Bonsoir BsAlv & 3GB pour vos réponses.
@3GB : Oui au désespoir de trouver une solution efficace et pérenne je risque d'être contraint d'utiliser les règles de message comme vous évoquez.
@BsAlv :
Le problème est qu'Outlook utilise je pense des profils. Chaque compte configuré est un profil. Donc pour effectuer cette opération il va falloir spécifier dans le code des informations sur chaque profil pour dire que je veux déplacer un e-mail d'un profil vers un autre.
J'ai essayé le code proposé en l'adaptant comme suit pour tester :
With Olk.GetNamespace("MAPI")
.GetDefaultFolder(5).Items(0).Move .GetDefaultFolder(16)
End WithLe chiffre 5 correspond au dossier Eléments envoyés tandis que le 16 corresponds au dossier Brouillons.
Par contre j'ai mis zéro comme argument de Items(0) car sincèrement je ne sais pas quel chiffre était attendu (l'exemple de code mentionnait c00 et dit que c'est un contrôle!!!)
Résultat : Erreur d'exécution dans le ligne GetDefaultFoloder : "code 440 - indice en dehors du champ".
De toute façon l'es instructions .GetDefaultFolder(x) ne donnent aucune indication sur le profil utilisé mais on devine que c'est le compte par défaut. Dans ce sens, même si ça marche, cela veut dire que le message ne peut-être transféré qu'entre les dossiers d'un même compte. Bref! ça n'a pas l'air d'être simple.
Encore merci
Bonsoir,
Je viens de faire un test qui fonctionne sur mon ordinateur personnel de la maison.
3 Comptes de messagerie sont définis chez moi : Un compte hotmail, un compte yahoo et un compte Hotmail (par défaut)
J'ai donc envoyé un e-mail vers la boîte yahoo en disant que le .Sender, .SendUsingAccount et .SentOnBehalfOfName est mon compte Gmail.
Résultat :Le message a bien été envoyé à mon compte Yahoo. Et il se trouve dans le dossier Elément envoyés du compte Gmail exactement comme je souhaitais.
Il se pourrait aussi que donc que la configuration de l'Outlook sur le PC portable professionnel soit très restrictive et qui explique qu'au niveau du travail ça ne fonctionne pas.
Cordialement,
avec ce macro sur une feuille vierge, vous pouvez voir le "tree des folders" d'Outlook. C'est du mêm site que hier, mais dans la partie néerlandais. http://www.snb-vba.eu/VBA_Outlook_external.html#L_1.4.2
Dans la colonne A, vous devez trouver vos 3 mailaddresses, 2 fois "Hotmail" et 1 fois "Yahoo".
Si je me rappèle bien, c'est comme-çà d'assigner les folders
set Fld1=Olk.GetNamespace("MAPI") .Folders("Ceickna1@hotmail.com").GetDefaultFolder(5)
set Fld2=Olk.GetNamespace("MAPI") .Folders("Ceickna@yahoo.com").GetDefaultFolder(5)
et puis il faut faire le "move" sur les bonnes emails.
fld1.Items(0).Move fld2
Mais, apparament, ce n'rst plus nécessaire.
Sub mappen_Outlookmappenstruktuur()
For Each fld In CreateObject("Outlook.Application").GetNamespace("MAPI").Folders
c01 = c01 & vbCr & vbCr & fld.Name & "|" & fld.Folders.Count & "|" & fld.Items.Count
For Each fld1 In fld.Folders
c01 = c01 & vbCr & "|" & fld1.Name & "|" & fld1.Folders.Count & "|" & fld1.Items.Count
For Each fld2 In fld1.Folders
c01 = c01 & vbCr & "||" & fld2.Name & "|" & fld2.Folders.Count & "|" & fld2.Items.Count
For Each fld3 In fld2.Folders
c01 = c01 & vbCr & "|||" & fld3.Name & "|" & fld3.Folders.Count & "|" & fld3.Items.Count
Next
Next
Next
Next
Sheets("Sheet1").Cells(1).Resize(UBound(Split(c01, vbCr)) - 1) = Application.Transpose(Split(Mid(c01, 3), vbCr))
Sheets("Sheet1").Columns(1).TextToColumns , 1, -4142, , False, False, False, False, True, "|"
End SubBonjour BsAlv,
Merci beaucoup. Même si dans ma configuration à mon domicile cela semble fonctionner, je vais quand même implémenter une fonction move avec les éléments que vous venez de me fournir. Si d'aventure, la fonction standard venait à ne pas fonctionner lorsque je serai sur un environnement d'entreprise, le Move explicite fera l'affaire. Ma difficulté était de lister les e-mail configurés sur un poste, ce que votre dernier message décrit.
Encore merci et bon dimanche
voir http://www.snb-vba.eu/VBA_Outlook_external_en.html#L_5.3.2
si je comprend bien, c'est de bien définer les mails que vous devez deplacer, par exemple, si le subject contient "controle", il sera deplacer de l'un folder vers l'autre. On sait aussi combiner 2 choses, par exemple subject et ".to" ou ...
,
Sub emails_verzonden_filter_move()
c00 = "controle"
With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(5).Items.Restrict("[Subject]='" & c00 & "'")
it.Move .GetDefaultFolder(3)
Next
End With
End SubBonjour BsAlv,
En fait je ne peux pas utiliser un For each dans cet contexte car la boîte e-mail professionnelle qui doit être utilisé comme Expéditrice des messages n'est pas utilisée que par mon application. Plusieurs assistants l'utilisent également d'où la nécessité de bien choisir le filtre au niveau du code car le problème est qu'il peut y avoir le même [Subject] dans d'autres e-mails qui ne sont pas les miens, donc je ne dois pas les transférer. C'est pour cela que pour moi le plus simple était de créer le message, de l'envoyer et avant la fermeture de l'objet MailItem d'enchainer avec le transfert du message vers le dossier éléments envoyés d'une autre boîte aux lettres.
Je pense que fondamentalement il ya un problème particulier qui a trait à mon avis à deux raisons possibles : D'abord la configuration d'Outlook car ce n'est pas normal que cela fonctionne sur mon PC personnel mais que sur le PC professionnel le code fonctionne à l'exception de la présence du message envoyé dans le dossier Sent Items de l'adresse marqué comme celle d'envoi du mail. Ensuite, je me demande aussi si le fait d'utiliser le Display au lieu de Send ne joue pas aussi. car le display n'envoi pas tant que l'utilisateur n'a pas cliquer sur envoyer dans la fenêtre de présentation du mail. Mais si on clique sur ce bouton, ça devrait normalement apparaitre In Fine dans le bon dossier. bref!
c'est assez special, que vous pouvez utiliser des macros dans votre firme, normallement on interdit cela, précaution !
Puis Outlook n'aime pas ce "SEND", il y a un popup qui demande si c'est okay pour tans de minutes (or vous n'avez pas ce problème ???), qu'on peut contourner avec un SENDKEYS CTRL+ENTER. Si je dis cela, vos informaticiens se mettent en colère ... (?).
si, en utilisant le macro de ce matin 10:09, ne montre pas les emailaddresses concernés, c'est le point final.
S'il les montre, avec une combinason des conditions, on peut créer une liste exacte des mails concernés.
par example
- ".subject" contient "Récapitulatif hebdomadaire"
- ".body" contient un texte particulier, même bizar, comme certains mots de passe "xYz312@°_-^^"
- ".SentOnBehalfOfName" = "Dptachat@yahoo.fr"
- moment d'envoyer est un vendredi
- ...
si ces conditions sont okay = MOVE
Bonsoir
PROBLEME RESOLU finalement avec l'utilisation de la méthode SendUsingAccount qui était mal utilisé car il a besoin d'un objet Account et non d'une adresse e-mail.
Mais j'ai dû ajouter Microsoft Outlook 16.0 Object Library pour pouvoir déclarer un objet Account. A partir de là mon code modifié marche très bien comme ça devait être. Les messages envoyés apparaissent bien dans les éléments envoyés de la BAL qui n'est pas le compte par défaut.
Dim objAccount As Account, bCpteTrouve as boolean
With Omail
.Recipients.Add ("philr@yahoo.com")
.CC = "Chef@hotmail.com"
.Subject = "Test d'envoi"
If .Recipients.ResolveAll = False Then
'MsgBox "Probleme"
End If
.Body = "le corps du message"
bCpteTrouve = False
For Each objAccount In Olk.Session.Accounts
If objAccount.SmtpAddress = strEmailSender Then
Set .SendUsingAccount = objAccount
bCpteTrouve = True
Exit For
End If
Next objAccount
If bCpteTrouve = False Then 'Le compte expéditeur de mail n'a pas été trouvé. On force un compte par défaut
.SentOnBehalfOfName = "Dptachat@yahoo.fr" 'au cas ou le SendUsingAccount n'a pu être appelé.
End If
Omail.Display
Omail.Send
End With
Set Omail = Nothing
Set Olk = Nothing Merci beaucoup pour vos aides