Option Explicit

Sub CompletedMsg()
Dim olMsg As MailItem
Dim olFolder As Outlook.Folder
Dim bExists As Boolean
Const sFolderName As String = "Completed"    'the name of the Completed folder
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olMsg = ActiveInspector.currentItem
        Case olExplorer
            Set olMsg = Application.ActiveExplorer.Selection.Item(1)
    End Select
    For Each olFolder In Session.GetDefaultFolder(olFolderInbox).folders
        If olFolder.Name = sFolderName Then
            bExists = True
            Exit For
        End If
    Next olFolder
    If Not bExists = True Then
        Set olFolder = Session.GetDefaultFolder(olFolderInbox).folders.Add(sFolderName)
    End If
    olMsg.UnRead = False
    olMsg.Categories = "Completed"    'optional
    olMsg.Move olFolder

lbl_Exit:
    Set olMsg = Nothing
    Set olFolder = Nothing
    Exit Sub
End Sub