XL 2016 Envoi mail

Yes28

XLDnaute Nouveau
Bonjour,
J'ai crée un fichier il y a quelques mois qui fonctionnait mais aujourd'hui j'ai ce problème.
A force de modifier je me suis perdu et il bug en envoyant des mails toutes les secondes !! (une boite s'ouvre et demande d'accepter - je ne peux pas la retirer protection entreprise)
voici mon code :


VB:
Dim messagerie As Object
Dim email As Object
Dim cel As Range

Set messagerie = CreateObject("Outlook.Application")

For Each cel In Range("e9:e" & Range("e9").End(xlDown).Row)

Set email = messagerie.CreateItem(0)

With email
    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0

    If oOutlook Is Nothing Then
        Shell "Outlook.exe", vbHide
    End If
   
    'Liste des destinataires
   .To = Sheets("Adresses Mail Destinataires").Range("e9").Value
 
       'Sujet :
       .Subject = Sheets("Menu").Range("a113").Value
     

       'Corps du mail :
       .Body = "Bonjour," & vbCrLf _
       & vbCrLf _
       & "Vous trouverez ci joint la " & Sheets("Menu").Range("a113").Value & vbCrLf _
       & vbCrLf _
       & "Cordialement" & vbCrLf _
       & vbCrLf & vbCrLf _
       & "XXX XXXX"
   .Send

    End With
   
     Set email = Nothing
   
    Next cel
    Set messagerie = Nothing
   
    With ActiveWorkbook

.Close SaveChanges:=False
End With
 

Discussions similaires

Réponses
2
Affichages
201
Réponses
1
Affichages
311
Réponses
2
Affichages
110

Statistiques des forums

Discussions
312 104
Messages
2 085 326
Membres
102 862
dernier inscrit
Emma35400