PDA

View Full Version : Moving Sent Items To Another ARCHIVE Folder



harky
08-15-2019, 02:08 AM
I need some help. i not a code person :)

Is there a code where i can
add to outlook..

Email which i send will auto move it to ARCHIVE

From Inbox 'sent folder' to ARCHIVE

PST Name: SENT_ARCHIVE
Subfolder: SendFolder

harky
08-15-2019, 06:08 PM
this code not working




Sub CleanOutlook()


Dim objNS As Variant
Dim objSourceItems As Items
Dim objSourceItem As MailItem
Dim objDestinationFolder As Folder
Dim IC As Integer




On Error Resume Next


Set objNS = Application.GetNamespace("MAPI")


'Moves Sent Items
Set objDestinationFolder = Folder("SENT_ARCHIVE\Sent Items")
Set objSourceItems = objNS.GetDefaultFolder(olFolderSentMail).Items


IC = objSourceItems.Count()
For i = IC To 1 Step -1
objSourceItems(i).Move objDestinationFolder
Next i


Set objSourceItems = objNS.GetDefaultFolder(olFolderDeletedItems).Items


IC = objSourceItems.Count()
For i = IC To 1 Step -1
objSourceItems(i).Delete
Next i




End Sub

harky
08-15-2019, 07:23 PM
Manage to find the code i want but..

how possible to auto run marco or possible to run the marco every 1 sec?




Sub MoveSentItem()


On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, olFolderSentMail As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem


Set objNS = Application.GetNamespace("MAPI")
Set olFolderSentMail = objNS.GetDefaultFolder(olFolderSentMail)
'For the "Item" portion, I used the name of the folder exactly as it appear in the ToolTip when I hover over it.
Set objFolder = objNS.Folders.Item("SENT_ARCHIVE").Folders.Item("Sent Items")


'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 = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move objFolder
End If
End If
Next
End Sub

gmayor
08-16-2019, 12:04 AM
You really don't want to be attempting to run anything every second that takes more than a second to run. It would effectively stop you doing anything else. Also as your macro requires you to select the items you want to move, then it is difficult to see how you propose to do that automatically. It makes more sense just to run it manually from time to time.

harky
08-16-2019, 04:20 AM
hi.

The reason is because i mass send email.
I can set rule to move all inbox to archieve but not sent email.

Tht y i want to use code, in case i am away?

As both will max and hit the email server space size :)