Lotus Message d'erreur lors de l'ouverture du courrier

SSIAP2

XLDnaute Occasionnel
Bonjour à tous

J'utilise cette macro pour envoyer un mail pré formaté

Code:
Sub EnvoiMail()

Dim EMailPJ As String
   Dim email(8) As String
  i = CInt((UserForm1.Nbdestinataire.Caption))
    For z = 1 To (i)
    email(z) = (UserForm1.ListView1.ListItems(z).ListSubItems(1).Text)
    'email(2) = (UserForm1.ListView1.ListItems(2).ListSubItems(1).Text)
    
    
    Application.StatusBar = "Envoi du mail à " & email(z)
        EnvoiRef = prvSendNotes(("Alerte accident lié au travail d'un agent(e) de la CCIV"), EMailPJ, email(z), SaveIt:=False)
    Next z
    MsgBox ("Mail Transmis")
End Sub
Function prvSendNotes(Subject As String, Attachment As String, Recipient As String, SaveIt As Boolean) As Boolean
   '*********************************************
    ' * Cocher la référence Lotus Domino Objects dans Outils, Références
    ' /////////////////////////////////////////////////////////////////////////
    ' * Modifier la ligne en remplaçant par le nom du Serveur Domino utilisé :
    '          Set dbDirectory = oSession.GetDbDirectory("EVREUX01/DEUTSCH")
    ' /////////////////////////////////////////////////////////////////////////
    ' * Mettre le mot de passe adapté dans la ligne :
    '           oSession.Initialize ("password")
    ' /////////////////////////////////////////////////////////////////////////
    ' Repris et développé par EvilGost
    ' Adapté par Eric RENAUD
    ' Subject: On met le sujet du mail
    ' Attachment: Chemin complet du fichier à attacher (ex: "C:\Excel\Test.xls"), sinon, mettre ""
    ' Recipient: Destinataire (ex: "support@ericrenaud.fr")
    ' Bodytext: Texte du mail
    ' SaveIt: Sauvegarde du mail dans les courriers envoyés
    '*************************************************************************************************************
    'Set up the objects required for Automation into lotus notes
    Dim Maildb As NotesDatabase    'The mail database
    Dim UserName As String    'The current users notes name
    Dim MailDoc As Object    'The mail document itself
    Dim AttachME As Object    'The attachment richtextfile object
    Dim oSession As NotesSession
    Dim dbDirectory As NotesDbDirectory
    Dim EmbedObj As Object    'The embedded object (Attachment)
    Dim maDate As String
    maDate = Format(Date, "dd-mm-yy")
    Dim objNotesField As Object

    On Error GoTo ErrHandle

    Set oSession = New NotesSession
    'Démarre une session de notes
    'La ligne suivante ne marche qu'avec les versions 5.x et 6.x , c'est l'injection du mot de passe

    oSession.Initialize ("mdp")

    'Récupère le nom par défaut de la session
    UserName = oSession.UserName

    'Ouvre la base mail en utilisant le serveur par défaut
    Set dbDirectory = oSession.GetDbDirectory("EVREUX01/DEUTSCH")    'vous pouvez mettre l'adresse du serveur dans ces parentheses
    Set Maildb = dbDirectory.OpenMailDatabase

    'Création du formulaire d'envoi de mail
    Set MailDoc = Maildb.CreateDocument()

    MailDoc.AppendItemValue "Subject", Subject    'remplissage du Sujet
    MailDoc.AppendItemValue "SendTo", Recipient
    MailDoc.AppendItemValue "ReturnReceipt", "1"    ' pour avoir un accusé réception (qu'avec des clients Lotus, Orange)
    Set objNotesField = MailDoc.CreateRichTextItem("Body")

       With objNotesField
        .AppendText ("Mr Me Veuillez trouver ci-joint la fiche victime suite à un accident sur le lieu de travail d'un agent(e):")
         .AddNewLine 1
         .AppendText (UserForm1.Z11.Text)
         .AddNewLine 3
         .AppendText ("Service de la victime:")
         .AddNewLine 1
         .AppendText (UserForm1.Z12.Text)
         .AddNewLine 3
         .AppendText ("Nom Prénom de la victime:")
         .AddNewLine 1
         .AppendText (UserForm1.Z6.Text) & " " & (UserForm1.Z7.Text)
          .AddNewLine 3
        .AppendText ("Date et heure de l'accident:")
         .AddNewLine 1
        .AppendText (UserForm1.TextBox4.Text) & " " & (UserForm1.Z2.Text) & " " & (UserForm1.Z3.Text)
        .AddNewLine 3
        .AppendText ("Lieu de l'accident:")
         .AddNewLine 1
        .AppendText (UserForm1.Z13.Text)
        .AddNewLine 3
        .AppendText ("Type d'accident:")
         .AddNewLine 1
        .AppendText (UserForm1.Z14.Text)
        .AddNewLine 3
        .AppendText ("Type évacuation:")
         .AddNewLine 1
        .AppendText (UserForm1.Z22.Text)
        .AddNewLine 2
        .AppendText "La feuille AT ou de maladie professionnelle a t'elle été remise à la victime?:" & " " & (UserForm1.Z25.Text)
        .AddNewLine 2
        .AppendText ("Circonstances de l'accident ou description des symptomes de la victime:")
        .AddNewLine 1
       .AppendText (UserForm1.Z15.Text)
        .AddNewLine 2
        .AppendText "Pour des d'informations complémentaires ou recevoir la fiche victime dans sont intégralité veuillez contacter le SSIAP2 " & " " & (UserForm1.Z4.Text) & " " & ("qui à pris en charge de la victime ou le chef du service de sécurité incendie Mr  . ")
        .AddNewLine 3
        .AppendText ("Contact Email:ssiap.aeroport@ Var.cci.fr ou d'un poste interne 8322")
        .AddNewLine 3
        .AppendText "Une copie de cette Email à été transmis aux destinataires suivant:"
        .AddNewLine 1
        .AppendText (UserForm1.MailNom.Caption)
        .AddNewLine 5
        .AppendText "Cordialement le Service de Sécurité d'incendie et Assistance aux personnes de l'aéroport Toulon-Hyéres"
    End With
    'Permet d'attacher un document au mail
    If UserForm1.CheckBox6 = True Then
        Set AttachME = MailDoc.CreateRichTextItem("Attachment")
        Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")
    End If

    'Envoi le document

    If SaveIt = True Then
        MailDoc.SaveMessageOnSend = SaveIt    'si à True, Lotus sauvegarde le mail envoyé
    End If

    Call MailDoc.Send(False)    'j'obtiens une erreur lorsque je mets true au lieu de false, si quelqu'un sait pourquoi

    prvSendNotesMail = True
    GoTo ExitHandle

ErrHandle:
    MsgBox Err.Description
    prvSendNotesMail = False

ExitHandle:
    'Vidage mémoire
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set oSession = Nothing
    Set dbDirectory = Nothing
    Set EmbedObj = Nothing
End Function



Lors de l'ouverture du mail par le destinataire j'ai ce message d'erreur

Le masque par defaut est introuvable j'ai donc ce message chez certain de mes collégues et d'autre tous ce passe bien.
Il y à t'il une erreur dans ma macro?

merci d'avance de votre aide et à trés bientot.
 
Dernière édition:
C

Compte Supprimé 979

Guest
Dernière modification par un modérateur:

Discussions similaires