Outlook macro to move replied / forwarded emails to a seperate folder

Sha

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
I am looking for a outlook macro to move replied/ forwarded emails to a separate folder. Can someone help me with this?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I am looking for a outlook macro to move replied/ forwarded emails to a separate folder. Can someone help me with this?





We can use the macro at http://www.slipstick.com/developer/macro-move-aged-mail/ as the base and change the property that it tests for.




Code:

 
 
Sub MoveAgedMail()
 
 

   Dim objOutlook As Outlook.Application
   Dim objNamespace As Outlook.NameSpace
   Dim objSourceFolder As Outlook.MAPIFolder
   Dim objDestFolder As Outlook.MAPIFolder
   Dim objVariant As Variant
   Dim lngMovedItems As Long
   Dim intCount As Integer
   Dim strDestFolder As String
   Dim lastverb, lastaction As String
   Dim propertyAccessor As Outlook.propertyAccessor
 
 

   Set objOutlook = Application
   Set objNamespace = objOutlook.GetNamespace("MAPI")
   Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
 
 

   For intCount = objSourceFolder.Items.count To 1 Step -1
       Set objVariant = objSourceFolder.Items.Item(intCount)
       DoEvents
       If objVariant.Class = olMail Then
       
       
  Set propertyAccessor = objVariant.propertyAccessor
 
 

   lastverb = "http://schemas.microsoft.com/mapi/proptag/0x10810003"
   lastaction = propertyAccessor.GetProperty(lastverb)
 
 

             ' 102, 103, 104 are replied, forwarded, reply all
           If lastaction > 7 Then
            
          ' use your datafile name and each folder in the path
          ' the example uses an email address because Outlook 2010
          ' uses email addresses for datafile names
          Set objDestFolder = objNamespace.Folders("me@domain.com"). _
                  Folders("Inbox").Folders("completed")

             objVariant.Move objDestFolder
              
             'count the # of items moved
              lngMovedItems = lngMovedItems + 1
               Set objDestFolder = Nothing
           End If
       End If
   Next
    
   ' Display the number of items that were moved.
   MsgBox "Moved " & lngMovedItems & " messages(s)."
 
 
Set objOutlook = Nothing
 
 
End Sub
 
Top