Dénombrement de message Outlook dans Excel

Le
berapard
Bonjour tous,

Je souhaiterais dans un Excel pouvoir dnombrer jour par jour les
messages reu dans Outlook et classer automatiquement dans un
rpertoire spcifique (Archives/EDI), distinct donc de la boite de
rception.

J'ai pris connaissance avec intrt grce 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 anticips

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
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