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
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas