Microsoft Outlook 2007: Inhoud map doorsturen en daarna verwijderen

[johhnnyboy]

Ik wil graag de email uit een map en onderliggende mappen laten doorsturen wanneer deze e-mail ouder is dan 2 jaar.
Dit zou ik of handmatig willen uitvoeren of bij het opstarten van outlook.

Kan dit?
Heb gezocht in zoekmappen. Ook eentje aangemaakt maar die zou ik dan 1 voor 1 nu moeten gaan doorsturen.
Heb ook gekeken naar de optie Postvak Opruimen maar ook nog niet de oplossing gevonden.

 

[OctaFish]

Je kunt een macro maken die bij het starten van Outlook de postbus controleert. Ik heb voor de test een mapje Kabinet gemaakt, en daar de mails die ouder zijn dan 10 dagen naar verplaatst.

Private Sub Application_Startup()
Dim myOlExp As Outlook.Explorer
' IGNORE - This forces the VBA project to open and be accessible using automation at any point after startup
Set myOlExp = Application.ActiveExplorer
Call Kabinet
End Sub

Deze code hierboven staat in de module ThisOutlookSession. De onderstaande overigens ook, maar die mag ook in een eigen module staan.

Sub Kabinet()
Dim objNS As NameSpace
Dim Inbox As MAPIFolder, objFolder As MAPIFolder
Dim objItem As MailItem
    
    'Verplaats geselecteerde mail(s) naar de map Kabinet.
    On Error Resume Next
 
    'Variabele initialiseren
    Set objNS = GetNamespace("MAPI")
    Set Inbox = objNS.GetDefaultFolder(olFolderInbox)
 
    'Specificeer folder welke door de topdeskapp server wordt uitgelezen
    Set objFolder = Inbox.Folders("Kabinet")
    'Checken of we wel in een mailbox zitten
    If objFolder Is Nothing Then
        MsgBox "Deze map bestaat niet!", vbOKOnly + vbExclamation, "Ongeldige Map..."
        Exit Sub
    End If
 
    'Stoppen als er geen mail is geselecteerd....
    If Inbox.Items.Count = 0 Then
        MsgBox "There are no messages in the Inbox.", vbInformation, "Nothing Found"
        Exit Sub
    End If
 MsgBox Inbox.Items.Count
    '.... en anders elk mailtje verplaatsen
    For Each objItem In Inbox.Items
        If objItem.Class = olMail Then
            If objItem.ReceivedTime < (Date - 10) Then
                objItem.UnRead = True
                objItem.FlagIcon = olBlueFlagIcon
                objItem.Save
                objItem.Move objFolder
            End If
        End If
    Next objItem
 
    On Error Resume Next
    Set objItem = Nothing
    Set objFolder = Nothing
    Set objNS = Nothing
 
End Sub

 

[johhnnyboy]

Heb je toevallig ook iets voor het vervolg van het verzenden van al deze e-mails uit de map "Kabinet" naar mijnemail@adres.nl?

Anders ga ik zelf eens in de macro's voor outlook duiken

 

[OctaFish]

I.p.v. opslaan in een mapje, krijg je dan een routine die de mail doorstuurt.

            If objItem.ReceivedTime < (Date - 10) Then
                Set olOutMail = objItem.Forward
                With olOutMail
                    .To = "Mailme@stupid.com"
                    .subject = olItem.subject
                    .HTMLBody = olItem.HTMLBody
                    .Display        'Change to .Send after testing
                End With
            End If