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
|
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'---------------------------------------------------------------------------------------
' Procedure : Application_NewMailEx
' Author : OCTU
' Date : 03/04/2015
' Purpose : Classe Les Emails a la reception dans le dossier si le sujet contient la structure #XM
'---------------------------------------------------------------------------------------
'
Dim objFolderDestination As MAPIFolder
Dim varEntryIDs
Dim Item
Dim i As Integer
varEntryIDs = Split(EntryIDCollection, ",")
For i = 0 To UBound(varEntryIDs)
Set Item = Application.Session.GetItemFromID(varEntryIDs(i))
If Not Item.Class = olMail Then GoTo fin
Dim DossierName
' If InStr(1, Item.Subject, "[info][code défaut]", vbTextCompare) Then
If InStr(1, Item.Sender, "notifications@railnova.eu", vbTextCompare) Then
DossierName = Num(Item.Subject, 1)
Set objFolderDestination = getDestinationFolder("Tests", DossierName)
Item.Move objFolderDestination
End If
Next
fin:
End Sub |
Partager