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
| Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim attachment As String
Dim rename As String
Dim subject As String
Dim recipient As String
Dim ccRecipient As String
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj As Object
Dim password As String
Dim objNotesField As Object
'Crée une session notes
Set Session = CreateObject("Notes.NotesSession")
attachment = rename
subject = Me![NumFab] & " - " & Me![NomCarte]
recipient = Me.Email
ccRecipient = "truc@yahoo.fr" & ", " & Me!CopieEmail
'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"
MailDoc.SendTo = recipient
MailDoc.CopyTo = Split(ccRecipient, ",")
MailDoc.subject = subject
Set objNotesField = MailDoc.CreateRichTextItem("Body")
With objNotesField
.AppendText "Bonjour,"
.AddNewLine 2
.AppendText "Veuillez trouver, ci-joint, ............"
.AddNewLine 2
.AppendText "Ce ..............."
.AddNewLine 2
.AppendText "Nous espérons ........."
End With
MailDoc.SAVEMESSAGEONSEND = SaveIt
'Prend en compte les pièces jointes
rename = Me!NumFab & ".pdf"
Name "S:\Base de Données\Certificat.pdf" As "S:\Base de Données\" & rename
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, recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing |
Partager