Private Sub Application_NewMail()


'Written by Lee Mason
'Platform: Outlook VBA
'Purpose: Checks inbox for read mail and (in this case) moves it to
'an folder. Also counts unread mail in mailbox.

------------------

On Error goto 1000

'Declares and initialised variables
Dim myOlApp As Application
Dim myNameSpace As NameSpace
Dim myibox As MAPIFolder
Dim mydelitems As MAPIFolder
Dim myitem As MailItem
Dim n As Integer
Dim unreadmail As Integer

n = 1
unreadmail = 0
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myibox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set mymovefolder = myibox.Folders("Old Items")

'Looks at items in the inbox and moves to
'Inbox/Old Items Folder if read, otherwise adds to the
'running count of unread items.

For n = 1 To myibox.Items.Count
    Set myitem = myibox.Items(n)
    If myitem.UnRead = True Then
        unreadmail = unreadmail + 1
    Else: myitem.Move mymovefolder
   
    End If
Next n

1000 msgbox err.name