XL 2016 Send from...Account or Send on behalf

[Bullrot]

Bonjour à tous

J'ai bien avancé dans mon code et tout fonctionne parfaitement sauf (et oui sinon je ne serais pas la ) qu'il envoie depuis mon compte principal.

Le but de mon code c'est qu'il s'adapte de lui même en fonction de la ou il se trouve, si il est chez le client A alors les différentes adresse du client A seront dans la liste de choix des From. Si client B idem etc etc...

Evidement, certain client travail aussi avec des Send on Behalf, donc eux aussi doivent apparaitre si ils sont actif sur le compte outlook..


Comment je peux faire cela?

Je le met dans mon userform

Private Sub PreviewMail_Click()
Dim ListeDest() 'variable dans tableau USERS
    Dim ListeService() 'variable dans tableau USERS
    Dim ListeDistribution() 'variable dans tableau USERS
    Dim i As Long
    Dim oAccount As Outlook.Account 'ajouté en test
    Dim Outlookapp As Object
    Dim MItem As MailItem
    Dim sListeDest As String
    Set Outlookapp = CreateObject("outlook.application")
    Set Outlookapp = New Outlook.Application
    
    On Error Resume Next
    
    ListeDest() = Range("USERS[CDN MAIL]") 'variable dans tableau USERS
    ListeService() = Range("USERS[SERVICE MAIL UNCLASS]") 'variable dans tableau USERS
    ListeDistribution() = Range("USERS[DISTRIBUTION LIST UNCLASS]") 'variable dans tableau USERS



For i = LBound(ListeDest(), 1) To UBound(ListeDest(), 1)
        If ListeDest(i, 1) = "" Then
           GoTo nextI
        End If
        
Set MItem = Outlookapp.CreateItem(olMailItem) 'create new mail

        With MItem
            .SentOnBehalfOfName = TextBoxFrom.Text
            .To = ListeDest(i, 1)
            If FR.value Then .Subject = .Subject & "FR" & "/"
            If NL.value Then .Subject = .Subject & "NL" & "/"
            If EN.value Then .Subject = .Subject & "EN"
            If FR.value Then .Body = .Body & "FR" & Chr(10) & Chr(13) & ListeService(i, 1) & Chr(10) & Chr(13) & ListeDistribution(i, 1) & Chr(10) & Chr(13) & "Bonne journée" & Chr(10) & Chr(13)
            If NL.value Then .Body = .Body & "NL" & Chr(10) & Chr(13) & ListeService(i, 1) & Chr(10) & Chr(13) & ListeDistribution(i, 1) & Chr(10) & Chr(13) & "Bonne journée" & Chr(10) & Chr(13)
            If EN.value Then .Body = .Body & "EN" & Chr(10) & Chr(13) & ListeService(i, 1) & Chr(10) & Chr(13) & ListeDistribution(i, 1) & Chr(10) & Chr(13) & "Bonne journée" & Chr(10) & Chr(13)
            
            If TextBox1.value <> "" Then .Attachments.Add (Me.TextBox1.value)
            If TextBox2.value <> "" Then .Attachments.Add (Me.TextBox2.value)
            If TextBox3.value <> "" Then .Attachments.Add (Me.TextBox3.value)
        Set .SendUsingAccount = oAccount 'ajouté en test
            .Display
        End With
        
        Set MItem = Nothing
        GoTo Endsub
nextI:
    Next
Endsub:
    
End Sub