Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

306xshdi

XLDnaute Nouveau
[RESOLU] Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

Bonjour,

J'ai trouvé 2 codes différents pour envoyer un mail automatiquement à un destinataire avec Lotus Notes 6.5. Les 2 fonctionnent mais malheureusement, chacun d'eux comporte un peu problème qui me dérange.

1ère Méthode:
Code:
Sub SendNotesMail() 

On Error Resume Next 


    Dim Maildb As Object 'The mail database 
    Dim UserName As String 'The current users notes name 
    Dim MailDbName As String 'THe current users notes mail database name 
    Dim MailDoc As Object 'The mail document itself 
    Dim AttachME As Object 'The attachment richtextfile object 
    Dim Session As Object 'The notes session 
    Dim EmbedObj As Object 'The embedded object (Attachment) 
    
    Set Session = CreateObject("Notes.NotesSession") 
    UserName = Session.UserName 
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf" 
    'Open the mail database in notes 
    Set Maildb = Session.GetDatabase("", MailDbName) 
     If Maildb.IsOpen = True Then 
          'Already open for mail 
     Else 
      
     Maildb.OPENMAIL 
            
     End If 
    'Set up the new mail document 
    Set MailDoc = Maildb.CreateDocument 
    MailDoc.Form = "Memo" 
    MailDoc.Subject = "Envoi Automatique ......" 
    MailDoc.body = "message....."
    MailDoc.SAVEMESSAGEONSEND = saveit 
    
    
    'Send the document 
    MailDoc.PostedDate = Now()  
    MailDoc.Send 0, "306xshdi@xxxxxxx.fr" 
    'Clean Up 
    Set Maildb = Nothing 
    Set MailDoc = Nothing 
    Set AttachME = Nothing 
    Set Session = Nothing 
    Set EmbedObj = Nothing 
End Sub

Le petit soucis de ce code est que Lotus doit être ouvert sur le PC concerné sinon Lotus se lance mais il faut saisir le mot de passe (donc ce n'est pas automatique)

2ème Méthode:
Code:
Private Sub UseLotus() 
    Dim Session As Object 
    Dim db As Object 
    Dim doc As Object 
    Dim rtitem As Object 
    Dim object As Object 
    Dim fs As Object 
    Dim Principaux(2) As String 
    Dim Copies(3) As String 
    Dim dir As Object 
    Dim inti As Integer 
    Dim passwd As String 
      
    On Error GoTo TraiteErreur 
    
    'Demande le password Lotus
    passwd = ".....mot_de_passe_à_renseigner........" 
    
        
    ' Création de la session Notes 
    Set Session = CreateObject("Lotus.NOTESSESSION") 
    
    'Ouverture d'une session NOTES 
    Call Session.Initialize(passwd) 
    Set dir = Session.GetDbDirectory("......nom_du_serveur_à_renseigner.......") 
    Set db = dir.OpenMailDatabase 


    Set doc = db.CreateDocument 
    Call doc.AppendItemValue("Form", "Memo")
    Call doc.APPENDITEMVALUE("Sendto", "306xshdi@xxxxxxx.fr") 
    Call doc.AppendItemValue("subject", "Envoi Automatique.....") 
    Call doc.AppendItemValue("body", "Message....") 
    doc.SAVEMESSAGEONSEND = saveit 
  
        
    Call doc.Send(True) 
    Set object = Nothing 
    Set rtitem = Nothing 
    Set doc = Nothing 
    Set db = Nothing 
    Set Session = Nothing 
    Exit Sub 
TraiteErreur: 
    MsgBox "Erreur Critique durant l'envoi .", vbCritical, "Error" 
    Set object = Nothing 
    Set rtitem = Nothing 
    Set doc = Nothing 
    Set db = Nothing 
    Set Session = Nothing 
    Set fs = Nothing 
End Sub

Le soucis de ce code est que l'envoi est automatique (mot de passe passé en VBA) mais lors de l'ouverture du mail chez le destinataire, il y a 5 fois l'erreur: "Un masque enregistré ne doit pas contenir de sous-masque calculés" (et le message s'ouvre ensuite)


Quelqu'un a t-il une solution pour passer le mot de passe en automatique( via le code VBA) avec la 1ère méthode ou formater correctement le message (pour ne plus avoir d'erreur à la lecture) avec la 2ème méthode ?

D'avance merci
 
Dernière édition:

306xshdi

XLDnaute Nouveau
Re : Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

Bonjour,

Oui j'ai cherché sur ce forum et sur le net (c'est de ces différents sujets que sortent mes 2 macros).

Pour l'instant, j'utilise la 2ème méthode qui me génére une erreur à l'ouverture du message (avec Lotus 6.5 mais pas apparemment avec Lotus 7)

Toutes les personnes utilisant la version 6.5 ont le problème mais pas de solution !
 

306xshdi

XLDnaute Nouveau
Re : Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

Bonjour,

J'ai enfin trouvé un code qui fonctionne avec la version Lotus 6.5 sans message d'erreur à l'ouverture du message et qui ne nécessite pas que Lotus soit ouvert (passage du mot de passe en vba)

Je le mets ci-dessous (si ca peut servir......)


Code:
Sub SendNotesMail()

    'Set up the objects required for Automation into lotus notes
    Dim Maildb As NotesDatabase    'The mail database
    Dim MailDoc As Object    'The mail document itself
    Dim oSession As NotesSession
    Dim dbDirectory As NotesDbDirectory
    Dim objNotesField As Object
    
    On Error GoTo ErrHandle
          
    
    'Démarre une session de notes
    Set oSession = New NotesSession
    'La ligne suivante ne marche qu'avec les versions 5.x et 6.x , c'est l'injection du mot de passe
    oSession.Initialize ("......mettre_le_mot_de_passe....")
    'Ouvre la base mail en utilisant le serveur par défaut
    Set dbDirectory = oSession.GetDbDirectory("....mettre_le_serveur.....")
    Set Maildb = dbDirectory.OpenMailDatabase
    'Création du formulaire d'envoi de mail
    Set MailDoc = Maildb.CreateDocument()
    MailDoc.AppendItemValue "Subject", "Sujet"
    MailDoc.AppendItemValue "SendTo", "306xshdi@......com"
    Set objNotesField = MailDoc.CreateRichTextItem("Body")
    With objNotesField
        .AppendText "message"
    End With
    'Envoi le document
    If SaveIt = True Then
        MailDoc.SaveMessageOnSend = SaveIt    'si à True, Lotus sauvegarde le mail envoyé
    End If
    Call MailDoc.Send(False)
    GoTo ExitHandle
ErrHandle:
    MsgBox Err.Description
ExitHandle:
    'Vidage mémoire
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set oSession = Nothing
    Set dbDirectory = Nothing
    Set objNotesField = Nothing
    
End Sub
 

oliviou

XLDnaute Nouveau
Re : Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

A toutes fins utiles, le problème dans la deuxieme méthode est lié à

Call doc.Send(True) si tu mais False il n'y plus de soucis à l'ouverture du message chez le recipient.
 

RENAUDER

Nous a quitté
Repose en paix
Re : Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

Bonjour,

Voilà un code que j'utilise tous les jours mais avec Lotus Notes 7.
Lotus n'a pas besoin d'être ouvert et le mot de passe est passé via le code VBA.
Il faut mettre la référence Lotus Domino Objects.

Il y a quelques modifications à effectuer sur ces 2 lignes.
oSession.Initialize ("password")
Set dbDirectory = oSession.GetDbDirectory("EVREUX01/DEUTSCH")

Code:
Sub Envoimail()
    Dim EMailPJ As String
    Dim Email(3) As String
    Email(1) = "[EMAIL="erenaud@deutsch.net"]erenaud@deutsch.net[/EMAIL]"
    Email(2) = "[EMAIL="erenaud@orange.fr"]erenaud@orange.fr[/EMAIL]"
    For Z = 1 To 2
        EnvoiRef = prvSendNotesMail("Valorisation OF en cours (KKAO)", "", Email(Z), SaveIt:=False)
    Next Z
End Sub
Function prvSendNotesMail(Subject As String, Attachment As String, Recipient As String, SaveIt As Boolean) As Boolean
    '*********************************************
    'Repris et développé par EvilGost
    ' Adapté par Eric RENAUD
    'Subject: Sujet du mail
    'Attachment: Chemin complet du fichier à attacher (ex: "C:\test.txt"),
    'sinon, mettre "" /
    'Recipient: Destinataire (ex: "[EMAIL="erenaud@hotmail.fr"]erenaud@hotmail.fr[/EMAIL]")
    '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 ("password")
    '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()
    ' Accusé reception
    ' MailDoc.AppendItemValue "ReturnReceipt", "1"
    MailDoc.AppendItemValue "Subject", Subject    'remplissage du Sujet
    MailDoc.AppendItemValue "SendTo", Recipient
    Set objNotesField = MailDoc.CreateRichTextItem("Body")
    With objNotesField
        .AppendText "Valorisation OF en cours (KKAO)"
        .AddNewLine 2
        .AppendText "************************************************************************************************************************"
        .AddNewLine 2
        .AppendText "Le fichier est déposé sur V:\TRANSFER\FEDERICO\KKAO\KKAO.xls"
        .AddNewLine 2
        .AppendText "------------------------------------------------------------------------------------------------------------------------"
        .AddNewLine 2
        .AppendText "Cet e-mail a été généré par un processus automatique."
        '.APPENDTEXT "Please follow established contact " & _
         "procedures should you have any questions."
        .AddNewLine 2
        .AppendText "Cordialement"
        .AddNewLine 1
        .AppendText "Eric RENAUD"
        .AddNewLine 1
        .AddNewLine 1
    End With
    'Permet d'attacher un document au mail
    If Attachment <> "" 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
 

Syntaxerror

XLDnaute Junior
Re : Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

Salut le Forum, salut le fil !
Je fais remonter ce très intéressant fil car en essayant d'appliquer le code de RENAUDER, j'ai le message d'erreur suivant :
"Erreur de compilation : projet ou bibliothèque introuvable"
J'ai coché toutes les référence qui commençaient par Lotus mais ça ne marche pas....
 

Roland_M

XLDnaute Barbatruc
Re : Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

bonjour à tous

voir avec cette routine à adapter bien sûr !

Code:
' --------- Envoi d'un mail avec Lotus Notes ---------- .
'Ajouter la référence Lotus Domino Objects (domobj.tlb) .
'Cocher Référence  [x]Lotus Domino Objects              .

Public Sub RoutineEnvoiMailLotus()
Application.ScreenUpdating = False
'------- compléter les variables nécessaires pour envoi --------------
AdresDestinataire$ = "??????" 'si plusieurs adresses séparer par le point virgule !
Sujet$ = "????????" ' sujet
Message$ = "??????" ' message
Fichier$ = "??????" ' "NomDuFichier.xls"
Chemin$ = "???????" ' chemin du fichier exp: = ThisWorkbook.Path
If Chemin$ > "" And Right(Chemin$, 1) <> "\" Then Chemin$ = Chemin$ & "\"
CheminEtFichier$ = Chemin$ & Fichier$

'------ départ envoi messagerie --------
'met en tableau si plusieurs adresses !?
If InStr(AdresDestinataire$, ";") = 0 Then AdresDestinataire$ = AdresDestinataire$ & ";"
Dim TabloAdresDestin As Variant
TabloAdresDestin = Split(AdresDestinataire$, ";")

'------ préparation session ------
On Error GoTo ErreurNET: Err.Clear

Dim oSession As Object     'CreateObject("Notes.NotesSession")
Dim UserName As String     'Nom d'utilisateur
Dim DataBase As Object     'Base des mails
Dim DataBaseName As String 'Nom de la base
Dim Document As Object     'Mail
Dim AttachME As Object     'Fich joint en RTF
Dim AttachF1 As Object     '1' pièce attachée

' Création de la session
Set oSession = CreateObject("Notes.NotesSession")
' Récupèration du nom d'utilisateur
UserName = oSession.UserName
DataBaseName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
' Ouvre la base des mails (si fermé, ouvre et demande le password)
Set DataBase = oSession.GetDataBase("", DataBaseName)
If Not DataBase.IsOpen Then DataBase.OpenMail

'       boucle envoi au(x) destinataire(s)
For I = LBound(TabloAdresDestin) To UBound(TabloAdresDestin)
 If Trim(TabloAdresDestin(I)) > "" Then
    AdresDestinataire$ = TabloAdresDestin(I)
    'crée le document et colle /AdresDestinataire /Sujet /Message
    Set Document = DataBase.CreateDocument
    Document.Form = "Memo"
    Document.Sendto = AdresDestinataire$
    Document.Subject = Sujet$
    Document.Body = Message$
    'Joint le Fichier s'il y a !?
    If CheminEtFichier$ <> "" Then
       Set AttachME = Document.CreateRichTextItem("Attachment")
       Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier, "Attachment")
    End If
    'Envoi le Mail
    Document.SaveMessageOnSend = True 'True = save dans les courriers envoyés
    Document.PostedDate = Now() ' date du jour
    Document.Send 0, AdresDestinataire$ 'envoi
    'reinit adresse suivante !?
    Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
 End If
Next
GoTo FinMail ' fin ########################################################

ErreurNET:
Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
T$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
GoTo FinMail

FinMail:
'libère les variables Object
Set oSession = Nothing: Set DataBase = Nothing
Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
On Error GoTo 0: Err.Clear
Application.ScreenUpdating = True
End Sub
 
Dernière édition:

Syntaxerror

XLDnaute Junior
Re : Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

Merci pour la réponse ! Ca marche impec !
Il me reste comme tu dis à "adapter". Notament si je veux un email avec plusieurs lignes, si je remplace ce morceau de code :
Code:
Set Document = DataBase.CreateDocument
    Document.Form = "Memo"
    Document.Sendto = AdresDestinataire$
    Document.Subject = Sujet$
    Document.Body = Message$
Par celui-ci :
Code:
Set objNotesField = Document.CreateRichTextItem("Body")
    With objNotesField
        .AppendText "Titre email"
        .AddNewLine 2
        .AppendText "************************************************************************************************************************"
        .AddNewLine 2
'...
est ce que ça peut marcher ?

bonne soirée à tous
 
Dernière édition:

Roland_M

XLDnaute Barbatruc
Re : Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

bonsoir

pour mettre un message j'utilise toujours cette combine très simple.
dans une feuille
je cré avec Dessin Zone de Texte que ne nomme par exemple "ZoneTexteMessage"
et j 'y entre tout le message. Avec autant de lignes et d'espaces que l'on veut.
et dans le code je récupère le message comme ceci:

Code:
NbrDeCar = Sheets(NomDeTaFeuil).Shapes("ZoneTexteMessage").TextFrame.Characters.Count
If NbrDeCar <= 255 Then
   Message$ = Sheets(NomDeTaFeuil).Shapes("ZoneTexteMessage").TextFrame.Characters.Text
Else
   Message$ = ""
   For Debut = 1 To NbrDeCar Step 255
     Message$ = Message$ & Sheets(NomDeTaFeuil).Shapes("ZoneTexteMessage").TextFrame.Characters(Debut, 255).Caption
   Next
End If

EDIT
je sais pas ou est ton message !?
mais supposons qu'il soit dans la Feuil1 en Col(A) sur 10 Lig
Message$ = ""
For Lig=1 to 10
Message$= Message$ & Sheets(TaFeuille).Cells(Lig, "A") & VbLf
Next

car on peut mettre un message de plusieurs lignes
en une seule variable et séparé avec VbLf (retour ligne)
 
Dernière édition:

muzomax

XLDnaute Nouveau
Re : Macro Excel pour Envoi mail automatique via Lotus Notes 6.5

EDIT
je sais pas ou est ton message !?
mais supposons qu'il soit dans la Feuil1 en Col(A) sur 10 Lig
Message$ = ""
For Lig=1 to 10
Message$= Message$ & Sheets(TaFeuille).Cells(Lig, "A") & VbLf
Next

car on peut mettre un message de plusieurs lignes
en une seule variable et séparé avec VbLf (retour ligne)

Bonjour,

J'ai essayé vos deux façon de faire mais il me met une erreur d'execution 13, incompatibilité de type

Merci de votre réponse

Edit : sinon la macro fonctionne très bien merci
 
Dernière édition:

Discussions similaires

Réponses
6
Affichages
269
Réponses
17
Affichages
1 K