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
| Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'---------------------------------------------------------------------------------------
' Procedure : test_change_image_embedded
' Author : OLIV
' Date : 15/06/2015
' Purpose : envoi avec ou sans pj et classement
'---------------------------------------------------------------------------------------
'
Dim MonDossierPJ
Dim FSO
Dim AFolder
MonDossierPJ = "c:\temp\PUBLIPOSTAGE_PJ\" 'ici on met les pj que l'on veut envoyer avec tous le Email "PUBLIPOSTAGE#PJ"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set AFolder = FSO.GetFolder(MonDossierPJ)
If Item.Class = olMail Then
Dim objCurrentMessage As MailItem
Set objCurrentMessage = Item
If InStr(1, objCurrentMessage.subject, "PUBLIPOSTAGE#PJ", vbTextCompare) > 0 Or InStr(1, objCurrentMessage.subject, "PUBLIPOSTAGE", vbTextCompare) > 0 Then
If InStr(1, objCurrentMessage.subject, "PUBLIPOSTAGE#PJ", vbTextCompare) > 0 Then
On Error Resume Next
Set TheFiles = AFolder.Files
For Each Afile In TheFiles
objCurrentMessage.Attachments.Add Source:=Afile.Path
Next Afile
End If
On Error GoTo 0
'On supprime les termes PUBLIPOSTAGE du sujet
objCurrentMessage.subject = Replace(objCurrentMessage.subject, "PUBLIPOSTAGE#PJ", "")
objCurrentMessage.subject = Replace(objCurrentMessage.subject, "PUBLIPOSTAGE", "")
'On sauvegarde le mail
objCurrentMessage.Save
'on classe le .msg dans windows
sav_mail_as_msg objCurrentMessage
End If
Set objCurrentMessage = Nothing
End If |
Partager