|
|
|
|
Salut tous,
Mon soucis est le suivant:
Sur un serveur Exchange, les règles de messagerie (tri,etc...) sont limitées à 32ko.
Mes users ont besoin de créer plusieurs centaines de règles, et donc la limite explose.
La grosse majorité de ces règles sont des règles "client seulement", voire la totalité.
Existe-t'il un moyen de ne pas transmettre ces règles sur le serveur, et donc de ne pas exploser cette limite?
Pour info, j'ai vu ceci:
http://www.forum-microsoft.org/ftopic76774.html
http://www.mapilab.com/exchange/rules/
http://faq.outlook.free.fr/articles.php
La plupart du temps la réponse est "padbol" :(
Merci d'avance
.Ô Messire Castor
(_)__ Sans Kangourou ni RagondinConfiguration: Windows XP
Internet Explorer 6.0
Répondre à UsulArrakis
|
Bon ca progresse un poil...
|
Bon on reprend (troisieme perte du post)
|
(j'ai supprimé le post ou tu mettais ton mail... Pas prudent ca :p )
Public WithEvents myOlItems As Outlook.Items
Public Sub Application_Startup()
Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
'---------------------------------
' CHANGE THE FOLLOWING SETTINGS
'---------------------------------
Excel_Workbook = "rules.xls"
Root_Folder_Name = "D:\Mail\"
Log_File_Name = "rules.log"
'---------------------------------
' DO NOT CHANGE THE FOLLOWING CODE
'---------------------------------
Excel_Workbook = Root_Folder_Name & Excel_Workbook
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myOrigFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myXlApp = CreateObject("Excel.Application")
Set myWorkBook = myXlApp.Workbooks.Open(Excel_Workbook)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If TypeName(Item) = "MailItem" Then
intRow = 2
Do Until myXlApp.Cells(intRow, 1).Value = "" And myXlApp.Cells(intRow, 2).Value = ""
' Parsing règle
If Not myXlApp.Cells(intRow, 1).Value = "" Then
' Address not null
If StrConv(Item.SenderEmailAddress, vbLowerCase) = StrConv(myXlApp.Cells(intRow, 1).Value, vbLowerCase) Then
If Not myXlApp.Cells(intRow, 3).Value = "" Then
' Archive not null
If Not moveMail(myDestArbo, myXlApp, intRow, myNameSpace, Item) Then MsgBox "Mail not moved to folder (line " & intRow & " in Rules File)", vbCritical, "Castor Sorting Script"
Exit Do
End If
End If
If InStr(1, StrConv(Item.SenderName, vbLowerCase), StrConv(myXlApp.Cells(intRow, 1).Value, vbLowerCase), vbTextCompare) Then
If Not myXlApp.Cells(intRow, 3).Value = "" Then
' Archive not null
If Not moveMail(myDestArbo, myXlApp, intRow, myNameSpace, Item) Then MsgBox "Mail not moved to folder (line " & intRow & " in Rules File)", vbCritical, "Castor Sorting Script"
Exit Do
End If
End If
End If
If Not myXlApp.Cells(intRow, 2).Value = "" Then
'Object not null
If InStr(1, Item.Subject, myXlApp.Cells(intRow, 2).Value, vbTextCompare) Then
If Not myXlApp.Cells(intRow, 3).Value = "" Then
' Archive not null
If Not moveMail(myDestArbo, myXlApp, intRow, myNameSpace, Item) Then MsgBox "Mail not moved to folder (line " & intRow & " in Rules File)", vbCritical, "Castor Sorting Script"
Exit Do
End If
End If
End If
intRow = intRow + 1
Loop
End If
myXlApp.Quit
End Sub
Function moveMail(myArbo, myXlFile, myIntRow, nameSpace, myItem) As Boolean
On Error Resume Next
myBool = True
Set myArbo = nameSpace.Folders(myXlFile.Cells(myIntRow, 3).Value)
mySubArbo = Split(myXlFile.Cells(myIntRow, 4).Value, "\", -1, vbTextCompare)
For Each Folder In mySubArbo
Set myArbo = myArbo.Folders(Folder)
If Err.Number Then
MsgBox "Error : Folder " & Folder & " doesn't exist", vbCritical, "Castor Sorting Script"
myBool = False
Exit For
End If
Next Folder
If myBool Then
myItem.move myArbo
End If
moveMail = myBool
End Function
Ça fonctionne avec un classeur excel (chez moi rules.xls, stocké dans d:\mail) Première ligne: titre (non prise en compte Colonne 1 : adresse mail ou nom colonne 2 : objet colonne 3 : Nom de l'archive PST pour le tri colonne 4 : Chemin dans l'archive .Ô Messire Castor (_)__ Sans Kangourou ni Ragondin |
Salut Messire Castor
|
Tiens messire Usul :)
|
III – LES CONTOURNEMENTS POSSIBLES
|
Une solution simple, mettre toutes les regles que l'ont souhaite sans les activer (case non coché) puis créer le script vba suivant :
|