VBA outlook mailbox question

[simonkrug]

Hi all

I would like a rule that automatically moves all emails in the inbox, which are 2 days old or more to a subfolder called “old”, and then deletes all emails in the subfolder “old”, if they are more that 30 days old.
This has to be done in a mailbox which is not the default mailbox. Therefore the code has to be designed for a mailbox named “xtendlink (test)”

 

[Davers]

Hi, I noticed you used the term "rule" so I'm not sure if you needed a rule in Outlook to do this for you, or if you needed code to do it for you...so I'm posting code to do it. I think this should work:

Sub MoveEmail()

Dim olMAPI As Object    'Outlook.Application
Dim moveFolder As Object     'Outlook.MAPIFolder
Dim InItem As Object     'Outlook.MAPIFolder
Dim MItem As Object     'Outlook.MailItem
Dim sentDate As Date
Dim sentDate2 As Date
Dim myDay As Integer
Dim i As Integer
   
Set olMAPI = GetObject("", "Outlook.Application").GetNamespace("MAPI")
Set InItem = olMAPI.Folders("xtendlink (test)").Folders("Inbox")
Set moveFolder = olMAPI.Folders("xtendlink (test)").Folders("Inbox").Folders("old")
Set dltFolder = olMAPI.Folders("xtendlink (test)").Folders("Deleted Items")

i = 0

If InItem.Items.Count = 0 Then

MsgBox InItem.Items.Count

    MsgBox "There are no messages in the Referral Folder.", vbInformation, _
           "Nothing Found"
    Exit Sub
    
End If

Count = InItem.Items.Count

For i = Count To 1 Step -1

    Set MItem = InItem.Items.Item(i)
    
    mySub = MItem.Subject
    sentDate = Format(MItem.SentOn, "mm/dd/yyyy")
    myDay = Date - sentDate

    If myDay >= 2 Then
        MItem.Move moveFolder
    End If
    
Next

Count2 = moveFolder.Items.Count

For i = Count2 To 1 Step -1

    Set MItem2 = moveFolder.Items.Item(i)
    
    sentDate2 = Format(MItem2.SentOn, "mm/dd/yyyy")
    myDay2 = Date - sentDate2
    
    If myDay2 >= 30 Then
        MItem2.Move dltFolder
    End If
   
Next

Set moveFolder = Nothing
Set dltFolder = Nothing
Set InItem = Nothing
Set MItem = Nothing
   
End Sub

You shouldn't need any references to Outlook, also, be sure to check the name of your folders to be sure they match what I've entered in the code. I've found that when this type of code doesn't run...99% of the time it's because of the folder names. Also, this isn't business days, it's just a straight days caculation. I don't have a way to do business days.

Hope this helps!

Dave

 

[simonkrug]

Thanks Dave

I've executed the code today - It seems to be running smooth

 

[war4peace]

This is some interesting piece of code, and I like it, but I have a more complex problem...
I have multiple mailboxes set up in Outlook and I need the following:
When code runs, it needs to check 4 Inbox folders for 4 mailboxes and do the following:
1. Get the amounts of messages in each inbox;
2. Get the oldes e-mail date from each inbox.

So how do I go about checking four accounts instead of just one? This is the part of code I do not understand (how to verify multiple accounts...)

 

[dk]

G'day

Here is some code that loops through multiple mailboxes and gets message count as well as the date of the oldest message. You just need to change the line arrMailboxes=Array(...... to match the names of your mailboxes.

This code uses CDO (Microsoft Collobarative Data Objects) as opposed the Outlook object model. This code should be quicker than the equivalent code using the Outlook obj model (although I haven't tested).

Let us know how you get on with this.

Cheers
DK

Sub MessageCountAndGetOldest()

Dim MapiSess As Object
Dim MapiFolderInbox As Object
Dim MapiItem As Object
Dim arrMailboxes As Variant, lArrIndex As Long
Dim dteOldest As Date


Set MapiSess = CreateObject("MAPI.Session")

MapiSess.Logon "%username%"


'Change this next line to match the name of your mailboxes
arrMailboxes = Array("Mailbox - Fred Smith", "Mailbox - John Smith", "Mailbox - Mary Smith", "Mailbox - Kevin Smith")

For lArrIndex = LBound(arrMailboxes) To UBound(arrMailboxes)

    Set MapiFolderInbox = MapiSess.InfoStores(arrMailboxes(lArrIndex)).RootFolder.Folders("Inbox")
        
        dteOldest = Date
        
        For Each MapiItem In MapiFolderInbox.Messages
            If MapiItem.TimeReceived < dteOldest Then dteOldest = MapiItem.TimeReceived
        Next MapiItem
     
        
        MsgBox "Message Count = " & MapiFolderInbox.Messages.Count & vbCr & _
               "Oldest Message Date = " & IIf(MapiFolderInbox.Messages.Count = 0, "N/A", dteOldest), vbInformation, "Info for mailbox " & arrMailboxes(lArrIndex)
     
          
Next lArrIndex

MapiSess.Logoff

End Sub

 

[war4peace]

Thanks for the sample; I already managed to get around by using and modifying previous code and everything works. I see your code performs a logon/logoff, which would prevent (if I get it correctly) unattended run. And I need the code to run unattended. Anyway, it's solved.
I will test this code later on, looks better than what I have.

 

[dk]

the login is performed in the code - no manual intervention needed so it can run unattended.

 

[GUILLE]

Hi ! I'm trying to make a SearchFolder (anywhere) with the content of other SearchFolders placed in different PST files (or Mailboxes). How can I do this?
Somebody, could please help me?