1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114
| Function Test_Mail()
Dim subject As String
Dim Attachment As String
Dim RECIPIENT As String
Dim ccRecipient As String
Dim bccRecipient As String
Dim BodyText As String
Dim SaveIt As Boolean
Dim Password As String
Dim oRst, oSql As DAO.Recordset
Dim oFld As DAO.Field
Dim oRecip As DAO.Recordset
Dim Maildb As Object 'La base des mails
Dim UserName As String 'Le nom d'utilisateur
Dim MailDbName As String 'Le nom de la base des mails
Dim MailDoc As Object 'Le mail
Dim AttachME As Object 'L'objet pièce jointe en RTF
Dim Session As Object 'La session Notes
Dim EmbedObj As Object 'L'objet incorporé
Dim uidoc As Object
Dim bodypart As Object
Dim UserNom As Variant
Dim recip, Chemin, Fichier, Ets, Adresse As Variant
Dim sEmplacementInitial As String, sEmplacementFinal As String
Dim body As String
Dim workspace As lotus.NOTESUIWORKSPACE
Dim space As Object
DoCmd.SetWarnings False
'body = LoadRTFFile("C:\TEST\Document.htm")
'ltexte = Call notesUIDocument.Import( [ filter$ , filename$ ] )
'Set otexte = oSource.Import("HTML", "C:\TEST\Document.htm")
Adresse = "C:\Documents and Settings\Eguillemard\My Documents\TEST\Document"
recip = " truc@truc.fr "
'Personne en copie des mails
bccRecipient = " truc@truc.fr "
'Sujet du mail
subject = "Mail Test " & Date
'Texte du mail
'BodyText = lTexte
'Set uidoc = workspace.CURRENTDOCUMENT
'uidoc.Import "HTML", "C:\TEST\Document.htm"
'Crée une session notes
Set Session = CreateObject("Notes.NotesSession")
'*** Cette ligne est réservée aux versions 5.x et supérieur : ***
'Session.Initialize (Password)
'Récupère le nom d'utilisateur et crée le nom de la base des mails
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Ouvre la base des mails
Set Maildb = Session.GetDatabase("", MailDbName)
If Not Maildb.IsOpen Then Maildb.Openmail
'Paramètre le mail à envoyer
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
'supprime la dernière virgule
MailDoc.SendTo = Left(recip, Len(recip))
MailDoc.CopyTo = ccRecipient
MailDoc.BlindCopyTo = bccRecipient
MailDoc.subject = subject
'Récupération du texte
Set bodypart = MailDoc.CreateRichTextItem("body")
With bodypart
.AppendText "Bonjour,"
End With
'BodyText = bodypart
'MailDoc.body = bodypart
'Affichage du mail dans Lotus Notes
'Set space = CreateObject("Notes.NotesUIWorkspace")
'Call space.EditDocument(True, MailDoc).FieldSetText("Bodypart", bodypart)
'Set uidoc = workspace.CURRENTDOCUMENT
'Call uidoc.Import("HTML", "C:\Documents and Settings\Eguillemard\My Documents\TEST\Document.htm")
MailDoc.SAVEMESSAGEONSEND = SaveIt
'__________________________________________________________________________________________________________________________
Attachment = "" & Adresse & ""
'Prend en compte les pièces jointes
If Attachment <> "" Then
Set AttachME = MailDoc.CreateRichTextItem("Attachment")
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")
End If
'Envoie le mail
MailDoc.PostedDate = Now()
MailDoc.send 0, recip
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
DoCmd.SetWarnings False
End Function |
Partager