Envoi d'un mail avec vba (excel) et lotus notes

Soyez le premier à donner votre avis sur cette source.

Snippet vu 65 304 fois - Téléchargée 26 fois

Contenu du snippet

Macro qui créer un mail et l 'envoi avec ou sans Lotus notes d'ouvert. La macro utilise les fonctions COM de lotus (version > 5.0.2b)

Condition de développement :
Windows 2000
Office 2000
Lotus Notes 5.0.10

Source / Exemple :


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(Dans le cas ou la session necessite un passwd)
    passwd = InputBox("Entrer votre password Lotus:", "Password")
    
    ' Création de la session Notes
    Set Session = CreateObject("Lotus.NOTESSESSION")
    
    'Ouverture d'une session NOTES
    Call Session.Initialize(passwd)'si pas de passwd pas de parametre pour initialize

    Set dir = Session.GETDBDIRECTORY("FranceServer1/DCI/BME/Omnia Group")
    Set db = dir.OpenMailDatabase
    
    ' Création d'un document
    Set doc = db.CREATEDOCUMENT

    'affectation du type mail
    Call doc.APPENDITEMVALUE("Form", "Memo")

    Call doc.APPENDITEMVALUE("Sendto", "destinataire@vba.com")
    Call doc.APPENDITEMVALUE("subject", "sujet")
    doc.SAVEMESSAGEONSEND = saveit 'sauvegarde du mail à l envoi
    
    Set rtitem = doc.createRichTextItem("Body")
    
    
    Dim nom As string 
    nom = ThisWorkbook.FullName
    'Attachement du classeur au mail
    Set object = rtitem.embedObject(1454, "", nom,"")
    
    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

Conclusion :


Si vous voulez envoyé plusieurs doc attaché c simple vous utiliser autant de fois qu il y a de doc à attacher cette fonction :

Set object = rtitem.embedObject(1454, "", "chemin et nomcomplet du doc","")

A voir également

Ajouter un commentaire

Commentaires

cs_EBArtSoft
Messages postés
4531
Date d'inscription
dimanche 29 septembre 2002
Statut
Modérateur
Dernière intervention
22 avril 2019
5 -
"utilise les fonctions .COM"> ya pas un "." en trop ?
ou bien tu confond avec un fichier *.com

"je l'ai adapté sans le testé"> pourquoi le poster alors ?
pourquoi distribuer des codes dont on n'est pas sur ?

"je ne suis pas sur de ce que renvoi la fonction fullname">
"t'est sur de rien, la ou je vie, ce que nous vivons c'est pas une vie, ici ou ailleur..." feat. Freeman copyright © 1998 lol ;-)

En fait je voulais juste faire une petite remarque sur le
fait qu'il faut toujours etre sur de ce que l'on fait ça evite bien
des commentaires idiot...

(...qui a dit "comme celui-ci ? )

@+
smallcop
Messages postés
9
Date d'inscription
jeudi 5 juin 2003
Statut
Membre
Dernière intervention
15 septembre 2005
-
Oui c'est COM dsl

Et si tu regardes le sujet du code c'est "Macro qui créer un mail et l 'envoi avec ou sans Lotus notes d'ouvert.", donc la fonction principale de ce code est l envoi d'un mail et ça : C'EST TESTÉ CA MARCHE. apres si l'on veux ajouter le classeur c'est en bonus et je previens que ce que j ai mis n'est pas sur à 100%. c'est vrai j'aurais pu envoyé un mail vide... mais bon je ne voyais pas l interet...

Je tiendrais compte de ta remarque pour la prochaine fois
smallcop
Messages postés
9
Date d'inscription
jeudi 5 juin 2003
Statut
Membre
Dernière intervention
15 septembre 2005
-
MAJ : CODE TESTE A 100% MARCHE A 100%
cs_Jack
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61 -
Salut smallcop
Toi qui a l'air d'avoir travaillé sur LotusNotes :
Saurais-tu comment demander à LotusNotes d'ouvrir un mail sans qu'il l'envoie, juste en lui donnant la liste des destinataires, un objet et c'est tout. Qu'il affiche le mémo, que tu puisses saisir le texte du message et faire l'envoi manuellement.
Ca fait un bout de temps que je cherche sans solution.
jmlucienvb
Messages postés
129
Date d'inscription
mercredi 24 septembre 2003
Statut
Membre
Dernière intervention
12 février 2009
-
Ce code répond à tous les cas possibles par exemple plusieurs destinayires...
Facile à adapter pour plusieurs doc en transformant attachment en tableau...j'utilise ce code tous les jours donc si besoin complément mail à :
jean-marc.lucien@acoss.fr
Dim Recipient(2) As Variant


Public Sub SendNotesMail(subject As String, Attachment As String, BodyText As String, SaveIt As Boolean)
'Set up the objects required for Automation into lotus notes
Recipient(0) = "Nom@XXX.fr"
Recipient(1) = "Nom2@xxx.fr"

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)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string
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.sendTo = Recipient '"Jean-Marc LUCIEN/AC750/REC" 'Recipient
mailDoc.subject = subject
mailDoc.body = BodyText
mailDoc.ReturnReceipt = "1"

mailDoc.SAVEMESSAGEONSEND = SaveIt
'Set up the embedded object and attachment and attach it
Attachment = "e:\Atelier\EnvoiCourrierParLotus\DIFI_COUR_COTG.xls" 'txtFromEmailAddress
If Attachment <> "" Then
Set AttachME = mailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
mailDoc.CREATERICHTEXTITEM ("Attachment")
End If
'Send the document
mailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
mailDoc.SEND 0, Recipient
'Clean Up
Set mailDb = Nothing
Set mailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.