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" <(E-Mail Removed)> wrote in message news:14ab0a86-1a25-45a7-8f5f-(E-Mail Removed)...
> 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