Wim‘s Excel, TM1 & soccer site

Items opkuisen in Outlook

08/11/2016

Inleiding

Even een uitstapje maken naar Outlook… ook in Outlook gebruik ik macro's om mijn werk te versnellen en te ontdoen van repititieve, hersendodende handelingen. Tot zulke handeling hoort zeker het uitkuisen/leeg maken van mappen de verwijderde items of de junk mail folder.

Hieronder toon ik jullie de macro die ik gebruik om 3 mappen automatisch leeg te maken, zonder meldingen van Outlook, gewoon leeg maken:

de map van de verwijderde items
de map van de junk
de map die (bij mij) heet: ZZ_Cleaned up

Die laatste behoeft wat uitleg vermoed ik. In Outlook heb je mogelijkheid om "dubbele" emails te verwijderen. "Dubbele emails" gaan over emails in een conversatie, waarbij er telkens geantwoord wordt door de vorige email onderaan bij te voegen. Al snel worden emails groot omdat ze de hele historiek van de conversatie bevatten. Als je dan de laatste van die emails bijhoudt, is dat zeker goed - je hebt geen kopies van kopies van emails nodig. Bevat een email een bijlage, dan wordt die email uiteraard wel nog behouden. Die "dubbele" emails kunnen dan door Outlook verplaatst worden naar een zelfgekozen map. Het is dan de bedoeling dat je die map leeg maakt en zo de overtollige emails verwijdert. Dat is hetgeen ik bedoel met de derde map hierboven.

VBA code

Hier is de code om zowel alle items als mappen binnen de 3 aangegeven mappen te verwijderen:

Sub RemoveDeletedItems()
' Wim Gielis
' https://www.wimgielis.com
'''''
' Code to clean up folders in Outlook
' 08/11/16
'''''
    Dim oJunkItems            As Outlook.Folder
    Dim oDeletedItems         As Outlook.Folder
    Dim oCleanedUpItems       As Outlook.Folder

    On Error Resume Next

    'Junk E-mail
    Set oJunkItems = Application.Session.GetDefaultFolder(23)    'olFolderJunk = 23
    CleanUp oJunkItems

    'Deleted Items
    Set oDeletedItems = Application.Session.GetDefaultFolder(3)    'olFolderDeletedItems = 3
    CleanUp oDeletedItems

    'ZZ_Cleaned up
    Set oCleanedUpItems = GetFolderPath("wgielis@aexis.com\Customers\TM1\ZZ_Cleaned up")
    CleanUp oCleanedUpItems

    On Error GoTo 0

End Sub

Sub CleanUp(fld As Outlook.Folder)
    Dim oFolders              As Outlook.Folders
    Dim oItems                As Outlook.Items
    Dim i                     As Long

    Set oItems = fld.Items
    For i = oItems.Count To 1 Step -1
        oItems.Item(i).Delete
    Next

    Set oFolders = fld.Folders
    For i = oFolders.Count To 1 Step -1
        oFolders.Item(i).Delete
    Next

End Sub

De attente lezer heeft al ontdekt dat 2 van de 3 mappen standaard benaderd kunnen worden via Outlook. Het zijn ingebouwde mappen in Outlook:

    Set oJunkItems = Application.Session.GetDefaultFolder(23)    'olFolderJunk = 23
    Set oDeletedItems = Application.Session.GetDefaultFolder(3)    'olFolderDeletedItems = 3

De map die ik zelf gecreëeerd heb is lastiger te achterhalen:

    Set oCleanedUpItems = GetFolderPath("wgielis@aexis.com\Customers\TM1\ZZ_Cleaned up")

Vandaar dat ik ook code nodig had om dat pad te vinden:

Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder

    'source to find the path to a folder:
    'http://www.outlook-tips.net/how-to/find-folder-path-in-mailbox/

    Dim oFolder               As Outlook.Folder
    Dim FoldersArray          As Variant
    Dim i                     As Integer
	Dim SubFolders            As Outlook.Folders

    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)

            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function

GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function

End Function

Voor wie een kortere versie verkiest van de macro "RemoveDeletedItems", zou nog kunnen gaan tot:

Sub RemoveDeletedItems()
    On Error Resume Next

    'Junk E-mail
    CleanUp Application.Session.GetDefaultFolder(23)    'olFolderJunk = 23

    'Deleted Items
    CleanUp Application.Session.GetDefaultFolder(3)    'olFolderDeletedItems = 3

    'ZZ_Cleaned up
    CleanUp GetFolderPath("wgielis@aexis.com\Customers\TM1\ZZ_Cleaned up")

    On Error GoTo 0

End Sub

Deze macro wijs ik toe aan een icoontje op de QAT en klaar ! :-)

Tot slot laat ik de macro automatisch uitvoeren wanneer Outlook gestart wordt. Zet deze code bij ThisOutlookSession:

Private Sub Application_Startup()

    'start Outlook in an organized way
    RemoveDeletedItems

End Sub

wimgielis.com

Excel, TM1 en voetbal

Items opkuisen in Outlook

Inleiding

VBA code

Homepage

Rubriek onderdelen

Over Wim

Andere links