GMail’s Archive feature in Outlook…

I love this feature. This, plus GMail’s great search, keeps my Inbox clean while making all of my past mail easily accessible. Of course, all you GMailers out there already know this.

Now, when it comes to Outlook… well… not so much.

I used to just delete stuff and use the ‘Deleted Items’ folder as my archive folder. But, that is not really an ideal solution. So, I thought that I would create an Archive folder and then move message to that instead. After some searching, I found and modified a Macro. This code is not original to me. Unfortunately, I didn’t document where I got it, so I can’t give proper credit. I even searched some this morning, looking for the original again, with no luck. But, whoever you are, thank you!

Tie this to a button and a key combo, and you have a nice archive folder. Works great for me… My Inbox is clean and I know where to look for past emails.

 

Sub MoveMessages(strFolder As String)
    Dim olkItem As Object, _
        olkFolder As Outlook.MAPIFolder
    Set olkFolder = OpenMAPIFolder(strFolder)
    If TypeName(olkFolder) = "MAPIFolder" Then
        For Each olkItem In Application.ActiveExplorer.Selection
            olkItem.UnRead = False
            olkItem.Save
            olkItem.Move olkFolder
        Next
    End If
    Set olkFolder = Nothing
    Set olkItem = Nothing
End Sub

Sub MoveTo_Archive()
    MoveMessages "\<MyMailbox>\_Archive"
End Sub

Function OpenMAPIFolder(szPath)
    Dim app, ns, flr, szDir, i
    Set flr = Nothing
    Set app = CreateObject("Outlook.Application")
    If Left(szPath, Len("\")) = "\" Then
        szPath = Mid(szPath, Len("\") + 1)
    Else
        Set flr = app.ActiveExplorer.CurrentFolder
    End If
    While szPath <> ""
        i = InStr(szPath, "\")
        If i Then
            szDir = Left(szPath, i - 1)
            szPath = Mid(szPath, i + Len("\"))
        Else
            szDir = szPath
            szPath = ""
        End If
        If IsNothing(flr) Then
            Set ns = app.GetNamespace("MAPI")
            Set flr = ns.Folders(szDir)
        Else
            Set flr = flr.Folders(szDir)
        End If
    Wend
    Set OpenMAPIFolder = flr
End Function

Function IsNothing(obj)
  If TypeName(obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function