humility36
New Member
- Joined
- Dec 16, 2019
- Messages
- 7
- Office Version
- 2016
- Platform
- Windows
Good Morning Excel friends,
Long time listener, First time caller. Not sure if y'all work on outlook VBA, but I thought I would give it a shot.
I'm really hoping someone here can help me out. I have a company policy where I work that retains email for 365 days and then deletes it. I have created some code through some VBA forums that will / should do the following:
1. scan the specified subfolder that I want to move old messages
2. look for emails that are old than 360 days
3. once it finds an email older that 360 days, move it to another .ost called "archive"
4. display a pop up that tells me how many messages have been moved.
My current version of outlook is:
Microsoft® Outlook® for Microsoft 365 MSO (Version 2202 Build 16.0.14931.21024) 64-bit
Running windows 10
Here is my code below:
My error is from this line:
objVariant.Move objDestFolder
The error I get is a runtime 440 error " cannot move items"
Thanks in advance for taking a look and any help you can provide. I appreciate it - Humility36
Long time listener, First time caller. Not sure if y'all work on outlook VBA, but I thought I would give it a shot.
I'm really hoping someone here can help me out. I have a company policy where I work that retains email for 365 days and then deletes it. I have created some code through some VBA forums that will / should do the following:
1. scan the specified subfolder that I want to move old messages
2. look for emails that are old than 360 days
3. once it finds an email older that 360 days, move it to another .ost called "archive"
4. display a pop up that tells me how many messages have been moved.
My current version of outlook is:
Microsoft® Outlook® for Microsoft 365 MSO (Version 2202 Build 16.0.14931.21024) 64-bit
Running windows 10
Here is my code below:
VBA Code:
Sub MoveAgedMailSolarwinds()
'Get the function from http://slipstick.me/qf
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
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox).Folders("External")
'Use a folder in a different data file
Set objDestFolder = GetFolderPath("Archive\Inbox")
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)
' adjust number of days as needed.
If intDateDiff > 360 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)from External."
Set objDestFolder = Nothing
End Sub
My error is from this line:
objVariant.Move objDestFolder
The error I get is a runtime 440 error " cannot move items"
Thanks in advance for taking a look and any help you can provide. I appreciate it - Humility36