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
| Option Base 1
Dim MesProjets()
Const MyprojectExcel = "U:\Développement informatique\MACRO\exemples\REGLES_OUTLOOK.xlsx"
Private Sub GetREGLES_XLSX()
Dim AppExcel As Excel.Application 'Application Excel
Dim wbExcel As Excel.Workbook 'Classeur Excel
Dim wsExcel As Excel.Worksheet 'Feuille Excel
Dim RgExcel As Excel.Range
'Ouverture de l'application
Set AppExcel = CreateObject("Excel.Application")
' AppExcel.Visible = False
'Ouverture d'un fichier Excel
Set wbExcel = AppExcel.Workbooks.Open(MyprojectExcel, , True)
'wsExcelProjects correspond à la première feuille du fichier
Set wsExcel = wbExcel.ActiveSheet
AppExcel.Visible = True
i = 1
Set RgExcel = wsExcel.Range(wsExcel.Range("A1"), wsExcel.Range("a65536").End(xlUp))
ReDim MesProjets(RgExcel.Count, 5)
For Each truc In RgExcel
MesProjets(i, 1) = truc.Value 'SUJET
MesProjets(i, 2) = truc.Offset(0, 1).Value 'EXPEDITEUR
MesProjets(i, 3) = truc.Offset(0, 2).Value 'DOSSIER_OUTLOOK_DESTINATION
MesProjets(i, 4) = truc.Offset(0, 3).Value 'DOSSIER_WINDOWS_DESTINATION
MesProjets(i, 5) = truc.Offset(0, 4).Value 'autres ?
i = i + 1
Next truc
wbExcel.Close False
AppExcel.Quit
Set wsExcel = Nothing
Set wbExcel = Nothing
Set AppExcel = Nothing
End Sub
Sub ScriptreglesXls(Mail As Outlook.MailItem)
'If MesProjets Is Nothing Then GetREGLES_XLSX
On Error Resume Next
If MesProjets(1, 1) = "" Then Call GetREGLES_XLSX
On Error GoTo 0
For i = 2 To UBound(MesProjets, 1)
'premier filtre sur le Sujet
If InStr(1, Mail.Subject, MesProjets(i, 1), vbTextCompare) = 0 Then GoTo suite
'actions selon l'expéditeur
If StrComp(Get_sender_SMTP(Mail), MesProjets(i, 2), vbTextCompare) = 0 Then
Call ExportSuppression_PJ_v2(MyMail:=Mail, Export:=True, Supp:=False, SuppEmbedded:=False, DirExport:=CStr(MesProjets(i, 4)), Deplace:=True, DossierMove:=CStr(MesProjets(i, 3)), BodyWrite:=False)
End If
suite:
Next i
End Sub |
Partager