Sub Envoyer_Mail_liste_filtrée_Outlook()
Dim DLig As Long, Lig As Long
Dim ObjOutlook As New Outlook.Application
Dim oBjMail As Outlook.MailItem
Dim Nom_Fichier As String
Dim Destinataire As String
' Activer la référence : Microsoft Scripting Runtime
' Définir l'Objet Dictionnaire
Dim MonDico As New Scripting.Dictionary
' Ou définir Mondico comme objet et Créer l'instance du dictionnaire
' Dim MonDico As Object
'Set MonDico = CreateObject("Scripting.Dictionary")
' Initialiser l'instance Outlook
Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
' Avec la base
With Sheets("base_PDV")
' Dernière ligne de la feuille
DLig = .Range("B" & Rows.Count).End(xlUp).Row
' Pour chaque ligne
For Lig = 2 To DLig
' Vérifier si ligne affichée
If .Range("B" & Lig).EntireRow.Hidden = False Then
' En cas d'erreur on continue le code
On Error Resume Next
' Tenter d'ajouter le mail au dictionnaire : doublon impossible
MonDico.Add .Range("B" & Lig).Value, ""
' Si pas d'erreur, ajouter l'adresse
If Err.Number = 0 Then
Destinataire = Destinataire & .Range("B" & Lig).Value & ";"
End If
On Error GoTo 0
End If
Next Lig
End With
' Envoyer le mail
With oBjMail
.BCC = Destinataire 'le destinataire
.Subject = ""
.Body = "Bonjour,"
'.Attachments.Add ActiveWorkbook.FullName
.Display
'.Send ' Ici tu peux l'activer si tu ne veux pas vérifier le mail
End With
' Effacer les variables objet pour libérer la mémoire
Set oBjMail = Nothing
Set ObjOutlook = Nothing
Set MonDico = Nothing
End Sub