Private Sub EnvoiMail_Click()
' Thierry (XLD)
Dim OLApplication As Outlook.Application, OLMail As Outlook.MailItem, ListeRésultat
Dim TableauRésultat, NbGrp As Long, i As Long, TableauGrp, j As Long
Const MaxAdr = 5 'j'ai placé le nbre de mails à 5 pour tester
'Résultat = Range("A1") 'je pense que tu t'en es servi pour tes tests
If ListeMails.ListCount = 0 Then Exit Sub
ListeRésultat = Split(Résultat, ";")
'NbGrp = Application.RoundUp((UBound(ListeRésultat) + 1) / MaxAdr, 0)
NbGrp = Application.RoundUp((UBound(ListeRésultat)) / MaxAdr, 0)
Set OLApplication = CreateObject("Outlook.Application")
For i = NbGrp To 1 Step -1
Résultat = ""
For j = (i - 1) * MaxAdr To i * MaxAdr - 1
If j > UBound(ListeRésultat) Then Exit For
Résultat = Résultat & ";" & ListeRésultat(j)
Next j
If Len(Résultat) > 0 Then Résultat = Right(Résultat, Len(Résultat) - 1)
Set OLMail = OLApplication.CreateItem(OLMailItem)
With OLMail
'.To = MailTo ' Destinataire
'.CC = MailCC ' Copie
.BCC = Résultat
.Importance = olImportanceNormal
.Subject = ObjetMessage ' Sujet
.Body = CorpsMessage ' Message
'.Attachments.Add CheminDestination ' Pièce jointe
.Categories = "Daily"
.OriginatorDeliveryReportRequested = True ' Accusé de dépôt
.ReadReceiptRequested = True ' Accusé de lecture
' .Send '<<<<<<<<<<<<<<<Pour envoyer directement
.Display '<<<<<<<<<<<<<Pour voir le mail avant envoi
End With
Next i
Set OLApplication = Nothing
Set OLMail = Nothing
Unload Me
End Sub