Dénombrement de message Outlook dans Excel

Le
berapard
Bonjour à tous,

Je souhaiterais dans un Excel pouvoir dénombrer jour par jour les
messages reçu dans Outlook et classer automatiquement dans un
répertoire spécifique (Archives/EDI), distinct donc de la boite de
réception.

J'ai pris connaissance avec intérêt grâce Excelabo du fichier de
Jacques B. mais malheureusement je n'arrive pas à adapter le code pour
lui faire lire autre chose que la "Inbox".

Pourriez vous donc m'aider à faire cette adaptation ?

Avec mes remerciements anticipés

Coridialement

Philippe

Sub LitMessagerie()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olxFolder = olns.GetDefaultFolder(6) '
olns.GetDefaultFolder(olFolderInbox)
Sheets("Litmessagerie").Select
On Error Resume Next
n = 2
For Each i In olxFolder.Items
Cells(n, 1) = i.Subject
Cells(n, 2).ClearComments
Cells(n, 2).AddComment Text:=Replace(i.Body, Chr(13), "")
Cells(n, 2).Comment.Shape.Height = 150
Cells(n, 2).Comment.Shape.Width = 300
Cells(n, 3) = i.SenderName
Cells(n, 4) = i.CreationTime
n = n + 1
Next
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #5284001
Bonjour.
La macro suivante copie les messages de la boîte de réception vers le
dossier "test", sous dossier des "dossiers personnels" :
(testé avec XL2007)

Sub test1()
Dim ol As Object, Doss As Object, Mess As MailItem
Dim Ctr As Long
Set ol = New Outlook.Application
Dim espace As Outlook.Namespace

Set espace = ol.GetNamespace("MAPI")
Set Doss = espace.GetDefaultFolder(6)
Set DossPerso = Doss.Parent
Set cible = DossPerso.Folders("test")
For Each Mess In Doss.Items
Set m = Mess.Copy
m.Move cible
'mess.Delete
Ctr = Ctr + 1
Next
MsgBox "Nombre de messages : " & Ctr
End Sub

"berapard"
Bonjour à tous,

Je souhaiterais dans un Excel pouvoir dénombrer jour par jour les
messages reçu dans Outlook et classer automatiquement dans un
répertoire spécifique (Archives/EDI), distinct donc de la boite de
réception.

J'ai pris connaissance avec intérêt grâce Excelabo du fichier de
Jacques B. mais malheureusement je n'arrive pas à adapter le code pour
lui faire lire autre chose que la "Inbox".

Pourriez vous donc m'aider à faire cette adaptation ?

Avec mes remerciements anticipés

Coridialement

Philippe

Sub LitMessagerie()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olxFolder = olns.GetDefaultFolder(6) '
olns.GetDefaultFolder(olFolderInbox)
Sheets("Litmessagerie").Select
On Error Resume Next
n = 2
For Each i In olxFolder.Items
Cells(n, 1) = i.Subject
Cells(n, 2).ClearComments
Cells(n, 2).AddComment Text:=Replace(i.Body, Chr(13), "")
Cells(n, 2).Comment.Shape.Height = 150
Cells(n, 2).Comment.Shape.Width = 300
Cells(n, 3) = i.SenderName
Cells(n, 4) = i.CreationTime
n = n + 1
Next
End Sub
Daniel.C
Le #5283971
Note : Dans Outils / Références, tu dois cocher "Microsoft Outlook xx Object
Library"
Daniel
"Daniel.C"
Bonjour.
La macro suivante copie les messages de la boîte de réception vers le
dossier "test", sous dossier des "dossiers personnels" :
(testé avec XL2007)

Sub test1()
Dim ol As Object, Doss As Object, Mess As MailItem
Dim Ctr As Long
Set ol = New Outlook.Application
Dim espace As Outlook.Namespace

Set espace = ol.GetNamespace("MAPI")
Set Doss = espace.GetDefaultFolder(6)
Set DossPerso = Doss.Parent
Set cible = DossPerso.Folders("test")
For Each Mess In Doss.Items
Set m = Mess.Copy
m.Move cible
'mess.Delete
Ctr = Ctr + 1
Next
MsgBox "Nombre de messages : " & Ctr
End Sub

"berapard"
Bonjour à tous,

Je souhaiterais dans un Excel pouvoir dénombrer jour par jour les
messages reçu dans Outlook et classer automatiquement dans un
répertoire spécifique (Archives/EDI), distinct donc de la boite de
réception.

J'ai pris connaissance avec intérêt grâce Excelabo du fichier de
Jacques B. mais malheureusement je n'arrive pas à adapter le code pour
lui faire lire autre chose que la "Inbox".

Pourriez vous donc m'aider à faire cette adaptation ?

Avec mes remerciements anticipés

Coridialement

Philippe

Sub LitMessagerie()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olxFolder = olns.GetDefaultFolder(6) '
olns.GetDefaultFolder(olFolderInbox)
Sheets("Litmessagerie").Select
On Error Resume Next
n = 2
For Each i In olxFolder.Items
Cells(n, 1) = i.Subject
Cells(n, 2).ClearComments
Cells(n, 2).AddComment Text:=Replace(i.Body, Chr(13), "")
Cells(n, 2).Comment.Shape.Height = 150
Cells(n, 2).Comment.Shape.Width = 300
Cells(n, 3) = i.SenderName
Cells(n, 4) = i.CreationTime
n = n + 1
Next
End Sub



Publicité
Poster une réponse
Anonyme