XLS - Outlook : Gestion mails

Bonjour,

Existe t-il un moyen de réaliser un 'reporting' du nombre de mails reçu par jour dans le dossier boite de réception par VBA ?

C'est une question VBA Outlook et non Excel

Sub nombre_mail()
Dim CpteMess As Long
Dim Nb_mail_total As Long
Dim date_jour As Date
date_jour = InputBox("Merci de saisir la date comme indiqué par le format ci-dessous", "Date Butoir", "05/10/2015")
Dim str As String

'déclaration d'un objet de type Outlook
Dim MonApply As New Outlook.Application
Dim MonSpace  As Outlook.NameSpace
Dim MonMail As Outlook.MailItem
Dim FldDossier As Outlook.folder

'accès aux données de MAPI ayant les informations d'Outlook
Set MonSpace = MonApply.GetNamespace("Mapi")
Set FldDossier = Application.ActiveExplorer.CurrentFolder
Nb_mail_total = FldDossier.Items.Count
For i = 1 To Nb_mail_total
    'On vérifie le type d'item si c'est bien un mail
    str = TypeName(FldDossier.Items(i))
    If str = "MailItem" Then
        Set MonMail = FldDossier.Items(i)
        ' Comparaison sur la date
        If Format(MonMail.ReceivedTime, "mm/dd/yyyy") = Format(date_jour, "mm/dd/yyyy") Then
            CpteMess = CpteMess + 1
        End If
    str = Empty
    End If
Next i
'On affiche le résultat
MsgBox ("Nombre de mail du " & date_jour & Chr(13) & CpteMess)
End Sub

Bonjour Steelson,

Merci beaucoup, cela fonctionne très bien

J'aurais aimé savoir si on pourrais faire une présentation des différents jours, avec export XLS ?

Par exemple le 01/10 : 30 Mails Lister avec Objet du mail / Emetteur / Heure

Suivi du 2/10 , 3/10 etc...

Bon j'en demande beaucoup je l'admet

As-tu regardé dans les forum outlook ... nous sommes hors sujet ici !

Voici ma contribution

Sub liste_mail()

'déclaration d'un objet de type Outlook
Dim MonApply As New Outlook.Application
Dim MonSpace  As Outlook.NameSpace
Dim MonMail As Outlook.MailItem
Dim FldDossier As Outlook.folder
Dim str As String

'Excel
Dim excApp As Object, _
    excWkb As Object, _
    excWks As Object
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Add()
Set excWks = excWkb.Worksheets(1)
With excWks
    .Cells(1, 1) = "date - heure"
    .Cells(1, 2) = "émetteur"
    .Cells(1, 3) = "sujet"
End With
ligne = 2

'accès aux données de MAPI ayant les informations d'Outlook
Set MonSpace = MonApply.GetNamespace("Mapi")
Set FldDossier = Application.ActiveExplorer.CurrentFolder
Nb_mail_total = FldDossier.Items.Count
For i = 1 To Nb_mail_total
    'On vérifie le type d'item si c'est bien un mail
    str = TypeName(FldDossier.Items(i))
    If str = "MailItem" Then
        Set MonMail = FldDossier.Items(i)
        excWks.Cells(ligne, 1) = MonMail.ReceivedTime
        excWks.Cells(ligne, 2) = MonMail.SenderEmailAddress
        excWks.Cells(ligne, 3) = MonMail.Subject
        ligne = ligne + 1
        Set MonMail = Nothing
    str = Empty
    End If
Next i
excWks.Columns("A:C").AutoFit
MsgBox ("Fin d'exportation !")
excApp.Visible = True

Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing

End Sub

Super, cela fonctionne parfaitement et répond à mes attente en tout point.

Je vais ajouter d'autres données pour avoir un tableau complet.

Merci encore.

Rechercher des sujets similaires à "xls outlook gestion mails"