XL 2016 Problème envoi mail par macro suite passage Office 365

[Jean Michel]

Bonjour à toutes et à tous (et bonne année),

Nous avions une macro dans Excel 2016 qui envoyait des mails sans difficulté.
Comme dans toute entreprise, nous avons un mail perso et les mails partaient d'une boite groupe du service.
Depuis une bascule récente vers Office 365, il semblerait que les boites mails perso aient basculé dans office 365 mais pas les adresses groupes, ce qui fait que lorsque le mail d'envoi s'affiche si l'emetteur ne clique pas en choisissant la boite groupe, il y a un message d'erreur.
(le corps du message adressé n'est pas repris dans le code ci-dessous mais c'est un simple copier/coller).
Est-ce que l'un d'entre vous a rencontré ce problème et a trouvé une solution pour éviter d'être obligé de choisir la boite d'envoi ? (code ci-dessous qui fonctionnait bien et qui fonctionne toujours SI on sélectionne la boite groupe lorsque le mail s'affiche)

Merci

Sub envoyermail()
Dim oOutlook As Object
Set oOutlook = CreateObject("outlook.Application")
Dim oMail As Object
Set oMail = oOutlook.CreateItem(0)
oMail.Sender = boitegroupe@entreprise.com
oMail.SendUsingAccount = boitegroupe@entreprise.com
oMail.SentOnBehalfOfName = boitegroupe@entreprise.com

With oMail
Dim oObjetWord As Object
Set oObjetWord = .GetInspector.WordEditor
.To = Range("b6")
.CC = Range("b11")
.Importance = 2
.Subject = "Commande XXX"
oObjetWord.Range(0).Paste
.Display
End With

End Sub

 

[fanch55]

oMail.Sender = boitegroupe@entreprise.com
oMail.SendUsingAccount = boitegroupe@entreprise.com
oMail.SentOnBehalfOfName = boitegroupe@entreprise.com

Bonjour, cela n'a pas peut-être rien à voir, mais c'est étonnant de ne pas avoir encadré boitegroupe@entreprise.com par des guillemets ....

 

[Jean Michel]

Bonjour Fanch55,

Ça peut paraitre étrange mais a priori, ça fonctionne sans les guillemets.
(je ferais une vérification lundi au boulot mais dans le C/C que j'ai fait de la source, il n'y en a pas)

Bon WE

 

[fanch55]

Ça peut paraitre étrange mais a priori, ça fonctionne sans les guillemets.

Sur mon office 2021, quand je mets les guillemets, cela fonctionne correctement,
je suis étonné que cela puisse fonctionner sans que ce soit sur 2016 ou 365 ....
On verra le retour du lundi

 

[Jean Michel]

Bonsoir Fanch55,
Vérification faite ce jour, tu as raison, les guillemets sont bien présents.

Bonne soirée.

 

[fanch55]

Vérification faite ce jour, tu as raison, les guillemets sont bien présents.

Bout de code à essayer :

Sub envoyermail()
Dim Account As Object
Dim Default As Boolean
    Box_Address = "boitegroupe@entreprise.com"
    With CreateObject("outlook.Application") ' Appel Outlook
        For Each Elem In .session.Accounts ' on regarde si Elem fait partie des comptes de l'utilisateur
            If Elem = Box_Address Then Set Account = Elem: Exit For
        Next
        If Account Is Nothing Then
            Set Account = .session.Accounts.Item(1) ' compte par défaut
            Default = True
        End If
        With .createitem(0)
            .Sender = Box_Address
            Set .SendUsingAccount = Account
            .SentOnBehalfOfName = Box_Address
            .To = Range("b6")
            .CC = Range("b11")
            .Importance = 2
            .Subject = "Commande XXX"
            If Default Then MsgBox "le compte pour l'envoi sera celui de" & vbLf & Account.UserName & " <" & Account.smtpaddress & ">"
            .Display ' indispensable içi avant d'appeler le getinspector
            With .GetInspector.WordEditor
                .Range(0).Paste
            End With
        End With
    End With

End Sub

 

[Jean Michel]

Bonsoir Fanch55,

Merci, je vais tester.

Bonne fin de journée.

 

[Jean Michel]

Bonsoir,
Je viens de tester.

Echec : "Nous n’avons pas pu envoyer ce message. Vous n'avez pas l'autorisation d'envoyer le message sous le nom de l'utilisateur spécifié"

Merci quand même, c'est sympa d'avoir proposé ce code.

 

[fanch55]

Un autre test pour récupérer le compte par défaut :

Sub envoyermail()
Dim Account As Object
Dim Compte  As Object

    Box_Address = "boitegroupe@entreprise.com"
    With CreateObject("outlook.Application") ' Appel Outlook
        Set Default_Store = .GetNameSpace("MAPI").defaultstore
        For Each Compte In .Session.Accounts
           ' on choisit le compte par defaut
            If Compte.DeliveryStore.storeid = Default_Store.storeid Then
                Set Account = Compte
                Exit For
            End If
        Next
        If Account Is Nothing Then
            MsgBox "Compte par défaut non trouvé", vbCritical
            Exit Sub
        End If
        With .createitem(0)
            .Sender = Box_Address
            Set .SendUsingAccount = Account
            .SentOnBehalfOfName = Box_Address
            .To = Range("b6")
            '.CC = Range("b11")
            .Importance = 2
            .Subject = "Commande XXX"
            .display ' indispensable içi avant d'appeler le getinspector
            With .GetInspector.WordEditor
                .Range(0).Paste
            End With
        End With
    End With

End Sub