zeps256
-
Modifié par jee pee le 21/09/2013 à 14:38
VB_TROYES
Messages postés15Date d'inscriptiondimanche 29 septembre 2013StatutMembreDernière intervention21 février 2014
-
23 nov. 2013 à 18:14
Bonjour,
J'ai une p'tite macro quime rapatrie sous xlsx, le listing de mes mails.
Mon pb est que je suis sur le dossier par défault de la boite de réception et que j'aimerais choisir le dossier en début de procédure.
Voici mon code ds son intégralité, si qq1 peut m'aider
Sub List_All_Mails()
Dim olExplorer As Outlook.Explorer
Dim OLF As Outlook.MAPIFolder
Dim mess As Outlook.MailItem
Dim i As Long, lngItemCount As Long, R As Integer
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6) ' 6 = inbox => Voir OlDefaultFolders, énumération
If OLF Is Nothing Then Exit Sub ' Outlook pas dispo
Application.ScreenUpdating = False
'Workbooks.Add ' creer un nouveau fichier
' mets les "en-tête" de colonne
Cells(1, 1).Formula = "Début"
Cells(1, 2).Formula = "Expéditeur"
Cells(1, 3).Formula = "Sujet"
Cells(1, 4).Formula = "Pas Ouvert ?"
Cells(1, 5).Formula = "Destinataires"
Cells(1, 6).Formula = "Corps du Message"
R = 1
With Range("A1:F1").Font
.Bold = True
.Underline = xlUnderlineStyleSingle
.Size = 12
.Color = RGB(0, 0, 0)
End With
lngItemCount = OLF.Items.Count 'compte le nb de message
For i = 1 To lngItemCount
If i Mod 10 = 0 Then
Application.StatusBar = "Reading appointment items " & Format(i / lngItemCount, "0%") & "..." 'affiche la barre de progression
DoEvents
End If
On Error Resume Next
Set mess = OLF.Items(i)
On Error GoTo 0
If Not mess Is Nothing Then
R = R + 1
With mess
Cells(R, 1).Formula = .SentOn
Cells(R, 2).Formula = .SenderName
Cells(R, 3).Formula = .Subject
Cells(R, 4).Formula = .UnRead 'Renvoie True si l'élément Outlook n'a pas été ouvert.
Cells(R, 5).Formula = .To
Cells(R, 6).Formula = .Body
End With
Set mess = Nothing
End If
Next i
Set OLF = Nothing
Columns("A:A").ColumnWidth = 17
Columns("B:B").ColumnWidth = 32
Columns("C:C").ColumnWidth = 85
Range("A2").Select
Application.StatusBar = False 'efface la barre de progression
Call suprChr10
End Sub
Reprends cela tu auras juste a définir le nom de ton dossier dans la variable dossier
Pr tester je t'ai ajouté un petit compte d'email pour etre sur que tu tapes bien sur le bon dossier.
Sub test()
On Error Resume Next
dossier = "dossier_de_ton_choix"
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)
Dim Folder As Outlook.MAPIFolder
Set Folder = olInbox.Folders(dossier)
MsgBox "Nombre de mails : " & Folder.Items.Count
End Sub
Voici un test à faire.
On voit si il le lit bien et compte le nombre de mail
Il faut:
- Créer un dossier dans Boite de Réception :
tu le nommes "Sous Dossier"
-Créer un sous dossier dans sous dossier tu le nommes
"Sous Sous Dossier"
Tu mets 2 mails dans "Sous Dossier" et 3 mails dans "Sous Sous Dossier" et regardes combien le code te ressort de mails pour chaque dossier et sous dossier on verra si il y accède bien.
Dans l'attente de ton retour ,
Sub test()
On Error Resume Next
sousdoss = "Sous Dossier" SousSousDossier = "Sous Sous Dossier"
Set olApp = Outlook.Application Set olNS = olApp.GetNamespace("MAPI") Set olInbox = olNS.GetDefaultFolder(olFolderInbox) Set Folder = olInbox.Folders(sousdoss) Set SubFolder = olInbox.Folders(sousdoss).Folders(SousSousDossier)
MsgBox "Nombre de mails Sous dossier : " & Folder.Items.Count MsgBox "Nombre de mails Sous sous dossier : " & SubFolder.Items.Count