Move outlook emails >90 days to shared drive (Desktop) Folder

Status
Not open for further replies.

Hemant Sonawane

New Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server 2010
Hi Diane

I am new to VBA macros, Please help me.
I found macro on this forum that moves the mails which are > 7 days within the oulook folder named as OLD. Can this macro amended to the level where macro can move emails > 90 days to Shared Drive (desktop) folder.
Below is the Macro for your reference

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 intDateDiff As Integer
  Dim strDestFolder As String
 
  Set objOutlook = Application
  Set objNamespace = objOutlook.GetNamespace("MAPI")
  Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
 
  ' use your datafile name and each folder in the path
  Set objDestFolder = objNamespace.Folders("xyz@domain.com"). _
  Folders("Inbox").Folders("Old")
 
  For intCount = objSourceFolder.Items.Count To 1 Step -1
  Set objVariant = objSourceFolder.Items.Item(intCount)
  DoEvents
  If objVariant.Class = olMail Then
 
  intDateDiff = DateDiff("d", objVariant.SentOn, Now)
  ' I'm using 90 days, adjust as needed.
  If intDateDiff > 45 Then
  objVariant.Move objDestFolder
  'count the # of items moved
  lngMovedItems = lngMovedItems + 1
 
  End If
  End If
  Next
 
  ' Display the number of items that were moved.
 
  MsgBox "Moved " & lngMovedItems & " messages(s)."
  Set objDestFolder = Nothing
  End Sub
 

Hemant Sonawane

New Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server 2010
Hi
Can you please do change the macro i will upadate the pathpath . i dnt knw how to change or the macro coding

Thanks
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
This should do it.
See http://www.slipstick.com/developer/how-to-use-outlooks-vba-editor/ if you need help using the VBA editor.
Code:
Sub SaveAgedMail()

Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Dim strDestFolder As String
Dim sName As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))

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


intDateDiff = DateDiff("d", objVariant.SentOn, Now)
' I'm using 90 days, adjust as needed.
If intDateDiff > 45 Then


sName = objVariant.subject
ReplaceCharsForFileName sName, "_"
dtDate = objVariant.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "-hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"
    
sPath = enviro & "\Documents\"


objVariant.SaveAs sPath & sName, olMSG

End If
End If
Next

End Sub


Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub
 

Hemant Sonawane

New Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server 2010
Hi Diane
I am new to macro. can you please let me know where can i put may email id in above macro. like it was given in first macro
[
' use your datafile name and each folder in the path
Set objDestFolder = objNamespace.Folders("xyz@domain.com"). _
Folders("Inbox").Folders("Old")
]
Thanks
-----------------
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
You want to move emails > 90 days to Shared Drive (desktop) folder. The code with the username moves them to a different pst file in your profile.

This line gets the messages that are in the inbox:
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)

and this line saves them in the my documents folder on the computer:
sPath = enviro & "\Documents\"

If the shared folder is under your user account (C:\users\me), change documents to the folder path, otherwise use
sPath ="C:\the\folder\path\"

If you want to delete them after you save them, use
objVariant.delete after the saveas.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
V Outlook 2016 will not move emails in search results Using Outlook 4
N Outlook 2010 exchange - auto-move emails from @domain Exchange Server Administration 1
B OUTLOOK 2013: How Do I Move Emails to Folders stored on my Hard Drive? Using Outlook 3
S Outlook macro to move replied / forwarded emails to a seperate folder Using Outlook 1
GregS Outlook 2016 Move Outlook to new computer? Using Outlook 4
witzker Macro to move @domain.xx of a Spammail to Blacklist in Outlook 2019 Outlook VBA and Custom Forms 7
S Macro to move “Re:” & “FWD:” email recieved the shared inbox to a subfolder in outlook Outlook VBA and Custom Forms 0
S Outlook Macro to move reply mail based on the key word in the subjectline Outlook VBA and Custom Forms 0
M move to iCloud not working in outlook calendar Using Outlook 12
C Move Outlook 2007 to new PC with Outlook 365 Using Outlook 3
K Outlook Rules: Move a Copy Using Outlook 4
P when i move inbox mails to another folder in outlook the mail disappears Using Outlook 1
F "Move to" O365 feature to Outlook client via VBA Outlook VBA and Custom Forms 4
C Move from Outlook 2007 Enterprise (MOE) to Outlook Pro plus 2007 Using Outlook 1
Cdub27 Move Outlook 2016 Contacts to Other Folders - Extremely Slow !! Using Outlook 6
M code to move selected Outlook contacts to another folder Using Outlook 3
G Favorites panel entries move around after restarting Outlook 2016 Using Outlook 1
acpete48317 Categorize and move Outlook Email Outlook VBA and Custom Forms 2
L pin to Outlook move mail Using Outlook 2
Diane Poremsky Can't import CSV or move Outlook items into EAS Accounts New Slipstick.com Articles 0
O Missing guide "Move an Outlook Personal Folders .pst File" New Slipstick.com Articles 4
Diane Poremsky Move Messages from File System into Outlook Folders New Slipstick.com Articles 0
F Move from POP3 to IMAP Outlook 2007 (Comcast) Using Outlook 7
D Looking to move away from exchange to outlook.com Using Outlook 4
E Outlook 2007: Problem with "Move to Folder >" button on toolbar Using Outlook 6
M Automatically move Outlook message to the specific folder when click on reply to all Using Outlook 4
B Outlook 2000 Rule to Move txt msg Not Working if size >24KB Using Outlook 3
C Outlook 2013 - Email Gets Sent - But Does Not Move From Outbox to Sent Box Using Outlook 4
N rule to move sent mail to the deleted folder in outlook Using Outlook 4
J Outlook Cannot Move Msgs to Folders (GMAIL IMAP) Using Outlook 1
G Outlook 2003 I need to move email to folder based on subject, using wild card Using Outlook 0
M VBA code needed to move from Outlook 2010 subfolder to Symantec Vault subfolde Using Outlook 0
M Outlook 2010 IMAP account message move behavior Using Outlook 15
A How to move responded emaisl automatically to sub folders in Outlook 2007 Using Outlook 0
mikolajek Outlook 2013 IMAP actions (message move / delete etc.) significantly delayed Using Outlook 0
E Automatically move to other Folder from Inbox when mail comes - MS Outlook Using Outlook 1
L Outlook 2010- Be able to move default Mail folders (Outbox, Draft, etc) Outlook Wishlist 1
D Unable to move the tasks pane in the To-do bar in Outlook 2007 Using Outlook 1
K Outlook Cached Mode - can't create rules to move email to another mailbox Using Outlook 2
Z Outlook 2007 move folders from one computer to another Using Outlook 1
Z Move outlook 2010 profile from one computer to another Using Outlook 7
Rupert Dragwater Is there a genuine simple way to move Eudora address to Outlook 2010 Using Outlook 2
R Outlook could help move messages to their usual folder Outlook Wishlist 3
J Move PST /changing default location in Outlook 2007 or 2010 64b on W7 64bit Using Outlook 2
M Best way to move outlook? Using Outlook 1
M Move 'Reply All' on Ribbon in Outlook 2010 Using Outlook 2
T More than one outlook account to setup & move Using Outlook 1
D User cannot move email messages within Outlook Inbox folder and sub-folders. Using Outlook 0
P move folders in outlook using vba Outlook VBA and Custom Forms 1
S Outlook 2007 'Move To Folders missing from Inbox Using Outlook 5

Similar threads

Top