Outlook macro to move messages between folders

So you want a macro that can move a message or group of messages from folder A to folder B while simultaneously marking them as read.  You want the macro to be flexible enough to handle any combination of folders.  Do I understand correctly?  

Yes. I would like a standard macro that can move the selected email, or emails to another folder. Most of what I have seen move a message from the inbox to a subfolder under the inbox. I was looking for something more flexible so that I can edit the macro and change the source and destination folders. In otherwords, move from folder to folder. Also, it would be nice to have the message marked read, but that's of secondary concern.
Thanks

That's a pretty simple order.  Here's the code for doing that.  Follow these instructions to use it.

1.  Start Outlook
2.  Click Tools->Macro->Visual Basic Editor
3.  If not already expanded, expand Modules and click on Module1
4.  Copy the code below and paste it into the right-hand pane of the VB editor window
5.  Click the diskette icon on the toolbar to save changes
6.  Close the VB Editor
7.  Click Tools->Macro->Security
8.  Set the Security Level to Medium

The macro is general.  It can handle moving items to any folder you pass to it.  Usage is:

    MoveMessages "\Folder\SubFolder"

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

'Credit where credit is due.
'The code below is not mine.  I found it somewhere on the internet but do
'not remember where or who the author is.  The original author(s) deserves all
'the credit for these functions.
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

I actually saw this code before and tried to use it without success. Where does the "\Folder\SubFolder" get used in theis script? Where would you subsitute it when adding additional macro?
Thanks

Also, the macro does not show up in the macro list so you cannot add it to the toolbar.

Works fine. You are excellent at this. I have 2 other open questions if you want to take a shot at them. Anyway, thank you very much.


https://www.experts-exchange.com/questions/22135483/Outlook-macro-to-change-priority.html

https://www.experts-exchange.com/questions/22406648/How-to-make-Outlook-toolbar-commands-appear-and-dissapear.html

> You are excellent at this.
Thanks!  Glad I could help out.

I'll have a look at the other questions.

How would you modify this to move all messages from one folder to another?  Basically I want to move all sent items to the archive sent items

I am getting an error with the above code. My Requirement is to move the items from one folder (inbox) to my personal folder.
Error shot attached. Please advice.
2009-12-30-165103.jpg