Discussion :

[jafouille]

Bonjour,

Je recherche urgemment un moyen de récupérer tous mes mails Reçus ou envoyé sur une plage horaire spécifique (exemple entre 20h et 7h).
J'ai parcouru le net en vain, j'ai trouvé une macro sur le forum mais qui modifie le champ (modifié le), ce que je ne souhaites pas.

Est-ce que quelqu'un peut m'aider SVP c'est très urgent.

Merci beaucoup

[jafouille]

En fait plus exactement, je cherche à retrouver les mails dans mon Outlook 2013 Qui ont été envoyés / reçus:
- entre 20h et 7h du matin
- durant les weekends
- durant les jours fériés

[clementmarcotte]

Urgent et bénévolat sont plutôt incompatibles. D'autant plus que tu as probablement quelques employés qui pourraient te le faire.

[jafouille]

Urgent et bénévolat sont plutôt incompatibles. D'autant plus que tu as probablement quelques employés qui pourraient te le faire.

Bonsoir,

Je ne comprends pas votre message, ni vos arguments et je n'ai aucun employé.
J'ai besoin de cela dans le cadre d'un malheureux litige. Si je demande, c'est que je n'y arrive pas. Laissez place aux bonnes intensions avant de blâmer ou juger non?

[Oliv-]

Bonsoir,

Si c'est urgent , tu peux utiliser ce code pour exporter vers excel la liste des Emails (dossier par dossier)

ensuite tu utiliseras les fonctions d'excel pour isoler l'heure et le jour et filtrer selon tes besoins.


il faut AJOUTER une référence à MICROSOFT EXCEL 1x.0 OBJECT LIBRARY dans VBE (ALT+F11)

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
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
Option Explicit
 
Sub ExportFolderItemsToExcel()
'---------------------------------------------------------------------------------------
' Procedure : ExportFolderItemsToExcel
' Author    : Oliv
' Date      : 10/11/2017
' Purpose   : export des informations d'Emails de la boite de reception vers excel
'---------------------------------------------------------------------------------------
'
    Dim oFolder As Object
    Dim criteria
    Dim oTable As Object
    Dim i, oRow, R, arr
 
    Const olFolderInbox = 6
    Const olUserItems = 0
 
    Dim OL As Object
    If UCase(Application) = "OUTLOOK" Then
        Set OL = Application
    Else
        Set OL = CreateObject("outlook.application")
    End If
 
    'Si on connait le nom
    Set oFolder = OL.Session.GetDefaultFolder(olFolderInbox)
 
    'si on veut choisir
 
    'Set oFolder = OL.Session.PickFolder
    criteria = "[MessageClass]='IPM.Note' or [MessageClass]='IPM.Post'"
    'criteria = "[MessageClass]='IPM.Activity'"
 
    Set oTable = oFolder.GetTable(criteria, olUserItems)
    On Error Resume Next
    With oTable.Columns
        ''.Add ("Duration") 'KO
        ''.Add ("Type") 'KO
        .Add ("ReceivedTime")
        .Add ("Senton")
        .Add ("Size")
        .Add ("To")
        .Add ("Cc")
        .Add ("Bcc")
        .Add ("Categories")
        .Add ("ConversationTopic")
        .Add ("ReceivedByName")
        .Add ("SenderName")
        ''.Add ("Sent") 'KO
        .Add ("SenderEmailAddress")
        .Add ("Unread")
        .Add ("http://schemas.microsoft.com/mapi/proptag/0x0E1B000B")    'PR_HASATTACH
        '.add ("http://schemas.microsoft.com/mapi/proptag/0x0E13000D") 'PR_MESSAGE_ATTACHMENTS
        '.add ("http://schemas.microsoft.com/mapi/proptag/0x37010102") 'PR_ATTACH_DATA_BIN
        '.add ("http://schemas.microsoft.com/mapi/proptag/0x0EA5001E") 'PR_SEARCH_ATTACHMENTS
        '.add ("http://schemas.microsoft.com/mapi/proptag/0x0E12000D") 'PR_MESSAGE_RECIPIENTS
        '"http://schemas.microsoft.com/mapi/proptag/0x0E13000D"
        '.add ("BodyFormat") KO
        '.add ("HTMLBody")KO
        .Add ("http://schemas.microsoft.com/mapi/proptag/0x1000001F")    '="Body"
        '' .add (" http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8596001E") 'attach name
 
 
    End With
    MsgBox oTable.GetRowCount
 
    Dim AppExcel As Object
    Dim Wk As Object, Ws As Object
    Set AppExcel = CreateObject("Excel.application")
    AppExcel.Visible = True
    Set Wk = AppExcel.Workbooks.Add
    Set Ws = Wk.ActiveSheet
 
    R = 2
    'Enumerate the table using test for EndOfTable
    For i = 1 To oTable.Columns.Count
        Ws.Cells(1, i).Value = oTable.Columns.Item(i).Name
        If Ws.Cells(1, i).Value = "http://schemas.microsoft.com/mapi/proptag/0x0E1B000B" Then Ws.Cells(1, i).Value = "PR_HASATTACH"
         If Ws.Cells(1, i).Value = "http://schemas.microsoft.com/mapi/proptag/0x1000001F" Then Ws.Cells(1, i).Value = "Body"
    Next i
    Ws.Cells.NumberFormat = "@"
    Ws.Range("C:H").NumberFormat = "General"
 
    'GoTo parcourir
    '     one row spanning several columns
    oTable.Sort "LastModificationTime", True
    arr = oTable.GetArray(oTable.GetRowCount)
 
    Dim Destination As Range
    Set Destination = Ws.Range("a2")
    Set Destination = Destination.Resize(UBound(arr, 1) + 1 - LBound(arr, 1), UBound(arr, 2) + 1 - LBound(arr, 2))
 
    On Error Resume Next
    Destination.Value = arr
 
    If Err = 1004 Then GoTo parcourir
    'quand cela ne marche pas cela vient du format de la colonne destination
    On Error GoTo 0
    GoTo mef
 
    'AUTRE METHODE on ecrit en parcourant les enregistrement et les colonnes
parcourir:
    'pour parcourir la table champs par champs
    oTable.MoveToStart
    Do Until (oTable.EndOfTable)
        On Error Resume Next
        Set oRow = oTable.GetNextRow()
        For i = 1 To oTable.Columns.Count
            Debug.Print oRow("Body")
            AppExcel.Cells(R, i).Value = oRow(oTable.Columns(i).Name)
        Next i
 
        R = R + 1
    Loop
 
    GoTo mef
 
mef:
 
    'mise en forme
    With Ws.Cells
        .AutoFilter
        .EntireColumn.AutoFit
    End With
 
    With Ws.Rows("1:1").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
        .Parent.Font.Bold = True
    End With
    Ws.Cells.WrapText = True
    Ws.Cells.WrapText = False
    Exit Sub
 
End Sub

[SR.SFC]

Bonjour,

Il y a possibilité de faire des recherches plus fine à partir de l'onglet "recherche" qui s'affiche lorsque l'on rentre dans la zone recherche.
Sinon, il y a les "dossier de recherches" qui permettent de faire des recherches très fines.