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
|
Sub valider() 'prepa fichier & mail
Application.DisplayAlerts = False
'destinataires
Sheets("liste personnel").Select
dp = Sheets("liste personnel").Cells(li1, 5).Value
dc = Sheets("liste personnel").Cells(li2, 5).Value
mois = Sheets("liste personnel").Cells(10, 6).Value
nummois = Sheets("liste personnel").Cells(13, 8).Value
annee = Sheets("liste personnel").Cells(9, 6).Value
domaine = Sheets("liste personnel").Cells(8, 8).Value
types = Sheets("liste personnel").Cells(8, 9).Value
onglet1 = "P" & " - " & mois & " " & annee
onglet2 = "S" & " - " & mois & " " & annee
Call prepafichier macro pour préparer la pièce jointe
Dim Maildb As Object 'mail
Dim UserName As String 'utilisateur
Dim MailDbName As String
Dim MailDoc As Object 'doc mail
Dim AttachME As Object 'jonction de fichiers
Dim Session As Object 'Session Lotus
Dim EmbedObj As Object 'objet attaché
With Application
.ScreenUpdating = False
.DisplayAlerts = False
'ouvrir session lotus
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'ouvrir les mails
Set Maildb = Session.getDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.Openmail
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo" 'Forme du mail
MailDoc.SendTo = dp 'Destinataire principal
If dc <> "" Then
MailDoc.CopyTo = dc 'Destinataire en copie
End If
'Objet du mail
MailDoc.Subject = "P - " & domaine & types & " - " & mois & " " & annee
' Construction du message avec pièces jointes
MailDoc.Body = "Bonjour," _
& Chr(10) & Chr(10) & "Vous trouverez ci-joint le pointage pour le " & domaine & "." _
& Chr(10) & Chr(10) & "Préciser la période à prendre en compte : " _
& Chr(10) & Chr(10) & " => Date de début : " _
& Chr(10) & Chr(10) & " => Date de fin : " _
& Chr(10) & Chr(10) & "Cordialement," _
MailDoc.SaveMessageOnSend = SaveIt
'pièce jointe
Attachment1 = ThisWorkbook.Path & "\envois\P" & nummois & annee & "_" & domaine & types & ".xlsx"
If Attachment1 <> "" Then
Set AttachME = MailDoc.CreateRichTextItem("Attachment1")
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment1, "Attachment1")
MailDoc.CreateRichTextItem (Attachment1)
End If
Set workspace = CreateObject("Notes.NotesUIWorkspace")
On Error Resume Next
Call workspace.EDITDOCUMENT(True, MailDoc).GOTOFIELD("Body")
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Application.DisplayAlerts = True
End Sub |
Partager