' This subroutine will move the select email object to a mail folder called "saved"
' which lives under the default Inbox folder and mark it Read.
' After moving it, it will copy a link to that email to the clipboard.
Sub MoveToSavedAndCopyLink()
' Must add a Reference to scrrun.dll and fm20.dll which should live in the windows\system32 directory
' Use Tools->References... in the Macro editor to add the reference.

On Error Resume Next
    Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
    Dim objNS As Outlook.NameSpace, objItem, objMovedItem As Outlook.MailItem
    Set objNS = Application.GetNamespace("MAPI")
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
    
    ' I will be using a folder called "saved" which lives under the default Inbox folder
    Set objFolder = objInbox.Folders("saved")

    'Assume this is a mail folder

    If objFolder Is Nothing Then
        MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
    End If
    
    If Application.ActiveExplorer.Selection.Count <> 1 Then
        'Require that this procedure be called only when exactly one message is selected
        Exit Sub
    End If

    ' Loop through each item in the Selection--this is probably unnecessary
    '     since we already know that there should only be one
    For Each objItem In Application.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            ' Make sure we're dealing with a mail item here
            If objItem.Class = olMail Then
                ' Mark it Read
                objItem.UnRead = False
                Dim txtMsg As String
                
                ' Move the mail item to the saved folder
                ' objMovedItem will contain a reference to the new object that lives in "saved"
                Set objMovedItem = objItem.Move(objFolder)
                
                ' Now build a link to that item.  The URI should start with "Outlook:"
                ' The body of the link is the EntryID for the item.
                txtMsg = "Outlook:" + objMovedItem.EntryID
                                                
                ' To get txtMsg onto the clipboard, we've got to stuff it into a DataObject
                ' and then copy the DataObject onto the system clipboard.
                Dim objMsg As New DataObject
                                
                objMsg.SetText txtMsg
                objMsg.PutInClipboard
                
                ' cleanup
                Set objMsg = Nothing
            End If
        End If
    Next

    ' cleanup
    Set objItem = Nothing
    Set objFolder = Nothing
    Set objInbox = Nothing
    Set objNS = Nothing
End Sub