Hello,

I try to make statistics about received mails automatically stored in
a specific folder in OL2007 (rule).

I found on the net a procedure which list the mails in the default
Inbox by I am not able to adapt it to a specific folder of my personal
*.pst file (Archives/EDI).

So does anybody could help me to customize this code.

Thancks by advance,

Best regards

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

You can play with this

Sub test()
Dim ns As Namespace
Dim myfolder As MAPIFolder

Set ns = GetNamespace("MAPI")
Set myfolder = ns.PickFolder

If Not myfolder Is Nothing Then
If myfolder.Items.Count = 0 Then
MsgBox "There are no messages in this folder : " & myfolder, _
vbInformation, "Nothing Found"
Else
MsgBox myfolder.Items.Count
End If
End If
End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"berapard" wrote in message ...
Hello,

I try to make statistics about received mails automatically stored in
a specific folder in OL2007 (rule).

I found on the net a procedure which list the mails in the default
Inbox by I am not able to adapt it to a specific folder of my personal
*.pst file (Archives/EDI).

So does anybody could help me to customize this code.

Thancks by advance,

Best regards

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