Outlook Change Email Categories

Sub change_email_category()


    Dim app As Outlook.Application
    Set app = CreateObject("Outlook.Application")

    Dim ns As Outlook.NameSpace
    Set ns = app.GetNamespace("MAPI")
    ns.Logon

    Dim emails As Outlook.MAPIFolder
    Set emails = ns.GetDefaultFolder(olFolderInbox)

    Dim folder As Outlook.MAPIFolder
    Set folder = emails.Folders("10_Work").Folders("BASF").Folders("_old")

    Dim obj As Object
    Dim msg As Outlook.MailItem
    For Each obj In folder.Items
        If TypeName(obj) = "MailItem" Then
            Set msg = obj
            msg.Categories = "[10_Work/BASF/_old]"
            msg.Save
        End If
    Next
    Beep

End Sub