Microsoft 365 Personnaliser l'objet dans envoi mails

Option Explicit
Private OL_App As Object
Private OL_Mail As Object
Private sSubject As String, sBody As String


Sub SendDocuments()
' Generate e-mails to be sent to a list of mail recipients, with a customized attachment and message for each person

Dim i As Long
Dim tabContactNames As Variant, tabContactEmails As Variant, tabFNames As Variant, tabFNames2 As Variant, tabFNames3 As Variant, derniere_ligne
Dim tabCodeSociété As Variant

' Init
Application.ScreenUpdating = False
' Open Outlook
On Error Resume Next
Set OL_App = GetObject(, "Outlook.Application")
If OL_App Is Nothing Then
    Set OL_App = CreateObject("Outlook.Application")
End If

On Error GoTo 0
' Read E-mail parameters
    sSubject = Sheets("Mail").Range("B3").Value
    sBody = Sheets("Mail").Range("B5").Value

'trouver la dernière ligne
    derniere_ligne = Sheets("Liste d'envoi").Range("A500").End(xlUp).Row
    
' Read Contact list
    tabCodeSociété = Sheets("Liste d'envoi").Range("A3:A" & derniere_ligne).Value


    tabContactNames = Sheets("Liste d'envoi").Range("C3:C" & derniere_ligne).Value
    tabContactEmails = Sheets("Liste d'envoi").Range("D3:D" & derniere_ligne).Value
    
    'Fichiers dossiers_comptables
    tabFNames = Sheets("Liste d'envoi").Range("E3:E" & derniere_ligne).Value
    
    'Fichiers dossiers fiscaux:
    tabFNames2 = Sheets("Liste d'envoi").Range("f3:F" & derniere_ligne).Value
    
   'Fichiers ANNEXES:
    tabFNames3 = Sheets("Liste d'envoi").Range("g3:g" & derniere_ligne).Value

' Generate e-mails
For i = 1 To UBound(tabContactNames, 1)


If tabContactNames(i, 1) <> vbNullString Then
    Call CreateNewMessage(tabContactNames(i, 1), tabContactEmails(i, 1), tabFNames(i, 1), tabFNames2(i, 1), tabFNames3(i, 1), tabCodeSociété(i, 1))
End If

Next i

    MsgBox "The process has been entirely completed."

Set OL_App = Nothing
Set OL_Mail = Nothing
Application.ScreenUpdating = True

End Sub


Private Sub CreateNewMessage(strContactName, strContactTo, strFName, strFName2, strFName3, strCodeSociété)
' Create a new message with the following inputs :
Set OL_Mail = OL_App.CreateItem(0)

With OL_Mail
    .To = strContactTo
    '.CC = "alias1@domain1.com"
    '.BCC = "alias2@domain1.com"
     .Subject = strCodeSociété & "-" & sSubject
     .Body = sBody
     .BodyFormat = 2 'Format : 0=undetermined; 1=plain text; 2= HTML; 3=rich text
     .Importance = 2 'Importance : 0=low; 1=normal; 2= high
     .Sensitivity = 0 'Confidentiality : 0=normal; 1=personal; 2=private; 3=confidential
     .Attachments.Add (strFName)
     .Attachments.Add (strFName2)
     .Attachments.Add (strFName3)
     'adresse mail de l'expéditeur :
     .SentOnBehalfOfName = Sheets("Mail").Range("B4").Value
    
    ' Sélectionner Display si on veut voir le message avant qu'il soit envoyé ou .send si on veut qu'il parte directement
     '.Display
     .Send
End With

    Set OL_Mail = Nothing

End Sub