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
| Option Explicit
Dim MyFolder As Outlook.folder
Dim NbItems As Integer
Dim MyBody As String
Dim MyObjet As String
Dim MyStrDate As Date
Dim i As Integer
Sub AnalyseCourriels()
'***
MsgBox ("Attendre le message de fin de traitement !")
'***
Set MyFolder = GetFolder("\\Fichier de données Outlook\Boîte de réception")
If Not (MyFolder Is Nothing) Then
'***
'*** Nombre total de courriel dans la boite de réception
'***
NbItems = MyFolder.items.Count
'***
If NbItems > 0 Then
'***
'*** on boucle sur les courriels
'***
For i = NbItems To 1 Step -1
'***
'*** On récupère les données de chaque courriel
'***
'*** https://docs.microsoft.com/fr-fr/office/vba/api/outlook.mailitem.itemproperties
'***
MyBody = MyFolder.items(i).Body
MyObjet = MyFolder.items(i).Subject
MyStrDate = MyFolder.items(i).ReceivedTime
'***
'*** On comptabilise les données courriels
'***
Select Case Month(MyStrDate)
Case 1
Case 2
Case 3
'***
'*** Je vous laisse programmer le reste
'*** et organiser vos tests et compteurs ...
End Select
'***
Next i
End If
End If
'***
MsgBox ("Fin de traitement.")
'***
'*** Penser aussi à la gestion des erreurs
'***
GestionErreur:
End Sub
Function GetFolder(ByVal FolderPath As String) As Outlook.folder
Dim TestFolder As Outlook.folder
Dim FoldersArray As Variant
Dim miTemp As Outlook.MailItem
Dim misTemp As Outlook.items
Dim i As Integer
On Error GoTo GetFolder_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set TestFolder = Application.Session.Folders.item(FoldersArray(0))
If Not TestFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = TestFolder.Folders
Set TestFolder = SubFolders.item(FoldersArray(i))
If TestFolder Is Nothing Then
Set GetFolder = Nothing
End If
Next
End If
'Return the TestFolder
Set GetFolder = TestFolder
Exit Function
GetFolder_Error:
Set GetFolder = Nothing
Exit Function
End Function |
Partager