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
| Function Test()
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 Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj As Object
Dim UserNom As Variant
Dim recip, Chemin, Fichier, Ets, Adresse As Variant
Dim Test As Domino.NotesRichTextStyle
Dim Test2 As Long
UserNom = Environ("username")
Dim REPONSE
DoCmd.SetWarnings False
REPONSE = MsgBox("Cette action permet d'envoyer un mail.", vbExclamation + vbYesNo, "AVERTISSEMENT")
If REPONSE = vbYes Then
'__________________________________________________________________________________________________________________________
Set oRst = CurrentDb.OpenRecordset("SELECT * FROM oTables2 WHERE User='" & UserNom & "'")
While Not oRst.EOF
Set Chemin = oRst.Fields("Chemin")
Set Fichier = oRst.Fields("NomTable")
Set Ets = oRst.Fields("Num")
Adresse = Chemin & Fichier
Set oSql = CurrentDb.OpenRecordset("SELECT * FROM Liste_RA_Email_Test WHERE Num_mag='" & Ets & "'")
Set recip = oSql.Fields("Email")
bccRecipient = ""
Subject = Date
'Texte du mail
BodyText = "Bonjour,"
Test2 = Test("bodytext").Bold
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Not Maildb.IsOpen Then Maildb.OPENMAIL
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.SENDTO = Left(recip, Len(recip))
MailDoc.CopyTo = ccRecipient
MailDoc.blindCopyTo = bccRecipient
MailDoc.Subject = Subject
MailDoc.body = BodyText
MailDoc.SAVEMESSAGEONSEND = SaveIt
'__________________________________________________________________________________________________________________________
Attachment = "" & Adresse & ""
If Attachment <> "" Then
Set AttachME = MailDoc.CreateRichTextItem("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
End If
MailDoc.PostedDate = Now()
MailDoc.SEND 0, recip
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
oRst.MoveNext
Wend
Else
DoCmd.SetWarnings False
End
End If
DoCmd.SetWarnings False
End Function |
Partager