Pb Envoi Mail Message Sécurité Outlook

Bonjour,

J'utilise le script suivant depuis 3 ans pour envoyer par mail mais je dois passer sous exchange et les tests se soldent par un message de sécurité outlook
Il faut que je trouve une solution : 50 mails à chaque envoi / 4fois par jour

Avez vous une solution pour ne pas avoir de message de sécurité Outlook.
J'ai vu la méthode CDO mais pouvez vous m'aider à convertir mon script

Je négocie en ce moment avec l'administrateur pour avoir une boite supplémentaire en SMTP

Merci de votre aide


Dim deb, fin As Integer
Dim RQ As String
Dim bds As Database
Dim rstdest, rstmail As Recordset
Dim Site, Requete, ObjetMail, ObjetNul, Sauvegarde As String
Dim ListeDest
DoCmd.SetWarnings False
Set bds = CurrentDb

Set rstmail = bds.OpenRecordset("SELECT * FROM TbMailListe WHERE TypeAlarme = 'Dest';")
rstmail.MoveFirst
While Not rstmail.EOF
Site = rstmail!Site
Requete = rstmail!Requete
ObjetMail = rstmail!ObjetMail
ObjetNul = rstmail!ObjetNul

Set rstdest = bds.OpenRecordset("SELECT [EMAIL] FROM TbMailDestinataires WHERE Site = '" & Site & "';")
ListeDest = ""
rstdest.MoveFirst
If Not rstdest.EOF Then
ListeDest = rstdest!EMAIL
rstdest.MoveNext
End If
While Not rstdest.EOF
ListeDest = ListeDest & ";" & rstdest!EMAIL
rstdest.MoveNext
Wend
rstdest.Close
If DCount("Dossier", Requete, "") > 0 Then

DoCmd.SendObject acSendQuery, Requete, acFormatXLS, ListeDest, , , ObjetMail, , False
Else
DoCmd.SendObject , , , ListeDest, , , ObjetNul, , False

End If

rstmail.MoveNext

Wend
rstmail.Close

Set bds = Nothing

--
casa