Bonjour,

J'ai une macro qui me permet d'envoyer automatiquement des mails à une base de clients listés dans excel.
Le problème est que quand j'ai envoie le mail le niveau de confidentialité est par défaut à 'INTERNAL USE ONLY'. Du coup les mails envoyés ne sortent pas.
C'est une solution groupe ( Microsoft Azure Information Protection) donc moi en filiale je n'ai pas la possibilité de le désactiver. Je peux uniquement choisir manuellement avant d'envoyer mais le nombre de mail est important pour se faire un à un.

Quelqu'un aurait un idée de changement du niveau de confidentialité par code VBA pour m'aider?
Le niveau de confidentialité doit être 'PUBLIC'


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
 
 
Private Sub EnvoieB_Click()
Dim LeMail As Variant
Dim Ligne As Integer
Dim LeTexte As String
Dim ListDest As String
Dim ListDestC As String
Dim NomFiche As String
Dim LI As Integer
Dim LY As Integer
 
Set LeMail = CreateObject("Outlook.Application") ' Création d'un objet Outlook
ListDestC = "xxxx@xxxx.com"
LeTexte = "Cher(s) client(s),bonjour! <br><br>Veuillez recevoir le relevé des frais et commissions prélevés sur votre compte n°  " & Range("a" & Ligne) & " ,sur <b>la période du 01/01/2021 au 31/12/2021."
 
For Ligne = FirstLine To EndLine
 
'MsgBox (FirstLine)
'MsgBox (EndLine)
    NomFiche = "EBF_RELEVE_" & Range("a" & Ligne) & "_2019" & ".pdf"
    If (Range("b" & Ligne) <> "" Or Range("c" & Ligne) <> "") And Len(Dir("D:\Files4Test\" & NomFiche)) > 0 Then
        If (Range("b" & Ligne) <> "" And Range("b" & Ligne) <> "") Then
            ListDest = Range("b" & Ligne) & ";" & Range("c" & Ligne)
            Else
                If (Range("b" & Ligne)) <> "" Then
                    ListDest = Range("b" & Ligne)
                Else
                    ListDest = Range("c" & Ligne)
                End If
        End If
 
        With LeMail.CreateItem(olItem)
            .Subject = "RELEVE DE FRAIS ET COMMISSIONS DU COMPTE " & Range("a" & Ligne)
            .To = ListDest
            .CC = ListDestC
            .HTMLBody = "Cher(s) client(s),bonjour! <br><br>Veuillez recevoir le relevé des frais et commissions prélevés sur votre compte n°  " & Range("a" & Ligne) & " ,sur <b>la période du 01/01/2021 au 31/12/2021."
            .Attachments.Add ("D:\Files4Test\" & NomFiche)
            .Send
        End With
        Range("f" & Ligne) = "Envoyé"
    Else
    Range("f" & Ligne) = "Fichier ou numéro de compte ou email incorrect ou inexistant"
    End If
Next Ligne
 
End Sub