langenoir11
XLDnaute Nouveau
Bonjour,
J'essaye d'envoyer des mails automatiquement àavec un message preformater à une liste de personnes.
Je ne comprend pas j'ai un message d'erreur "erreur d'execution '486276854 (e304010a) l'élément à été déplacé ou supprimé.
Le premier mail part bien mais cela bloque au deuxième.
Voici mon code
Ma liste d'email ce trouve dans la colonne N
et la liste d’identifiant est dans la colonne E
J'essaye d'envoyer des mails automatiquement àavec un message preformater à une liste de personnes.
Je ne comprend pas j'ai un message d'erreur "erreur d'execution '486276854 (e304010a) l'élément à été déplacé ou supprimé.
Le premier mail part bien mais cela bloque au deuxième.
Voici mon code
Ma liste d'email ce trouve dans la colonne N
et la liste d’identifiant est dans la colonne E
Code:
Sub MailsansPJ()
'On Error GoTo erreur1
'MsgBox "mail"
'Creation de l'objet e-mail
Dim ol As New Outlook.Application
Dim olmail As MailItem
Dim CurrFile As String
Dim NomFichier, NomDefautn As String
Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)
Dim VDestinataire As String
Dim VIdentifiant As String
Dim i As Integer
i = 2
'Destiantaire le premier
Do While i < 6
Range("N" & i).Select
VDestinataire = ActiveCell.Value
Range("E" & i).Select
VIdentifiant = ActiveCell.Value
'MsgBox VDestinataire
'MsgBox VIdentifiant
'Envoi du mail
'Caractéristiques de l'e-mail
With olmail
'Destinataire
.To = VDestinataire
'Objet du message
.Subject = "TEST Changement de votre identifiant et mot des passe TEST"
.Body = "Bonjour," _
& Chr(13) _
& Chr(13) _
& "Veuillez trouver ci dessous votre nouvel identifiant et mot de passe" _
& Chr(13) _
& Chr(13) _
& "Identifiant :" _
& VIdentifiant _
& Chr(13) _
& "Mot de passe : toto" _
& Chr(13) _
& Chr(13) _
& "Sincères salutations," _
& Chr(13) _
'envoi de la pièce jointe
'.Attachments.Add attachement
'Remplacez .Display par .send pour envoyer directement l'e-mail sans l'afficher dans Outlook
.Display
End With
'Introduction d'une temporisation permettant d'attendre le temps d'envoyer un mail avnat d'envoyer un autre
Application.StatusBar = "Merci de patienter"
Application.Wait Now + TimeValue("00:00:05")
Application.StatusBar = False
i = i + 1
Loop
GoTo Apreserreur
erreur1:
CreateObject("Wscript.shell").Popup "Erreur d'execution, risque de perte des données ! (Mail)" & Chr(10) & "Erreur Module 1" & Chr(10) & "CONTACTER L'admin", , "ERREUR CRITIQUE", vbCritical
Apreserreur:
End Sub