Discussion :

[DPhBxl]

Bonjour,

Une demande précédente m'a permis de connaître le code qui permet de décompter le nombre de mails dans un répertoire de Outlook par date de réception à partir de Access.

Voici le code pour rappel : (Pas oublier d'ajouter la référence Microsoft Outlook 16.0 Object Library dans Access)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Compare Database
Option Explicit
 
    'Variables et Objets de l'application Outlook
    Dim objOutlook As Outlook.Application
    Dim objNameSpace As Outlook.NameSpace
    Dim objRecipient As Outlook.Recipient
    Dim objMailFolderInbox As Outlook.MAPIFolder
    Dim strFiltre As String
    Dim lngInboxNow As Long
 
Sub OutlookMails()
 
On Error Resume Next
 
    'Ouvrir Outlook
    Set objOutlook = New Outlook.Application
 
    'Créer le NameSpace
    Set objNameSpace = objOutlook.GetNamespace("MAPI")
    objNameSpace.SendAndReceive (True)
 
    'Créer le récipient
    Set objRecipient = objNameSpace.CreateRecipient("Nom du compte Outlook")
    objRecipient.Resolve
 
    'Recherche du Folder Inbox
    If objRecipient.Resolved Then
        Set objMailFolderInbox = objNameSpace.GetSharedDefaultFolder(objRecipient, olFolderInbox)
    End If
 
    'Filtres de restriction sur la réception à la date du jour
    strFiltre = "[Receivedtime] <= '" & Format(Date, "dd/mm/yyyy") & "'"
 
    'Nombre de Mails dans le Folder Inbox à la date du jour
    lngInboxNow = objMailFolderInbox.Items.Restrict(strFiltre).Count
 
End Sub

J'aimerai à présent dénombrer le nombre de conversations et non pas de mails présent dans un répertoire. Pouvez-vous m'aider ?
Exemple : Si il y a 3 conversations de 5 mails dans Inbox, je voudrais que le code me renvoi la valeur 3 et pas 15.

Philippe

[Oliv-]

Bonjour,

Comme cela ca doit faire le job

Les Emails sans sujet étant regroupés comme 1 seule conversation.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Conversation_in_Folder()
'---------------------------------------------------------------------------------------
' Procedure : Conversations_in_Folder
' Author    : Oliv
' Date      : 08/04/2019
' Purpose   :
'---------------------------------------------------------------------------------------
'
 
    Dim oFolder As Outlook.Folder
    Dim criteria
    Dim oTable As Table
    Dim i, oRow, r, arr
    'Si on connait le nom
    '        Set oFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Tests")
 
    'si on veut choisir
 
    Set oFolder = Application.Session.PickFolder
    criteria = "[MessageClass]='IPM.Note' or [MessageClass]='IPM.Post'"
    Set oTable = oFolder.GetTable(criteria, olUserItems)
    With oTable.Columns
        .add ("ReceivedTime")
        .add ("Senton")
        .add ("Size")
        .add ("To")
        .add ("Cc")
        .add ("Bcc")
        .add ("Categories")
        .add ("ConversationTopic")
        .add ("ReceivedByName")
        .add ("SenderName")
        .add ("SenderEmailAddress")
        .add ("Unread")
        .add ("http://schemas.microsoft.com/mapi/proptag/0x0E1B000B")    'PR_HASATTACH
        .add ("http://schemas.microsoft.com/mapi/proptag/0x1000001F")    '="Body"
 
    End With
    'MsgBox oTable.GetRowCount
 
 
    'Enumerate the table using test for EndOfTable
 
    Dim mondico As Object
    Set mondico = CreateObject("Scripting.Dictionary")
 
    'pour parcourir la table champs par champs
    oTable.MoveToStart
    Do Until (oTable.EndOfTable)
        On Error Resume Next
        Set oRow = oTable.GetNextRow()
        ' MsgBox oRow("ConversationTopic")
        If Not mondico.Exists(oRow("ConversationTopic")) Then mondico.add oRow("ConversationTopic"), oRow("ConversationTopic")
 
 
    Loop
 
    MsgBox mondico.count & vbCr & " sur " & oTable.GetRowCount & " messages", vbOKOnly, "Nombre de conversations"
 
 
End Sub

[DPhBxl]

Merci beaucoup. Cela a l'air de fonctionner.