Exclure une adresse email dans Cci

[Lone-wolf]

Bonjour à tous,

Sub Messages()
  Dim olApp As Outlook.Application
   Dim olmail As MailItem
   Dim CurrFile As String
   Dim cell As Range
   Dim strcc As String
   Dim Chemin
    ChDrive "D"
    ChDir ("D:\Carnet d'adresses\")
   Set olApp = Outlook.Application
   Set olmail = olApp.CreateItem(olMailItem)
   For Each cell In ThisWorkbook.Sheets("Liste").Range("H2:H22")
   strcc = strcc & cell.Value & ";"
    Next
    olmail.To = Nouveau.email.Value
    olmail.cc = ""
    olmail.BCC = strcc
    olmail.Subject = ""
    olmail.Body = ""
    Chemin = Application.GetOpenFilename("*.*, *.*")
If VarType(Chemin) <> 11 Then
olmail.Attachments.Add Chemin
olmail.Display
End If
End Sub

d'après le code, olmail.BCC inclu Nouveau.email.Value.

Comment écrire le code pour que celui-ci ne sois pas inscrit dans les copies cachée? Merci de votre aide.

 

[Lone-wolf]

Re : Exclure une adresse email dans Cci

Problème résolu.

Le Code:

Sub Messages()
  Dim olApp As Outlook.Application
   Dim olmail As MailItem
   Dim CurrFile As String
   Dim cell As Range
   Dim strcc As String
   Dim Chemin
   Application.ScreenUpdating = False
    ChDrive "D"
    ChDir ("D:\Carnet d'adresses\")
   Set olApp = Outlook.Application
   Set olmail = olApp.CreateItem(olMailItem)
    Sheets("Liste").Activate
    Range([H2], [H65536].End(xlUp)).Select
    For Each cell In Selection
        strcc = strcc & cell.Value & ";"
    Next
    EnvoiMail = Nouveau.Email.Value
    CopieC = Split(strcc, ";")
    For i = 0 To UBound(CopieC) - 1
        If CopieC(i) = EnvoiMail Then
        Else
            EnvoiCopieC = EnvoiCopieC & CopieC(i) & ";"
        End If
    Next i
    olmail.To = Nouveau.Email.Value
    olmail.cc = ""
    olmail.BCC = Mid(EnvoiCopieC, 1, Len(EnvoiCopieC) - 1)
    olmail.Subject = ""
    olmail.Body = ""
    Chemin = Application.GetOpenFilename("*.*, *.*")
    olmail.Display
If VarType(Chemin) <> 11 Then
olmail.Attachments.Add Chemin
End If
End Sub

Ainsi que le code à inserer dans ThisWorkBook, si vous avez un ruban personnalisé:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.CommandBars(MyCommandBarName).Delete
End Sub