Need Help With VBA Script

[MarkJ247]

Hello All,

I am new to VBA Scripting and would like to create a script for Outlook 2016 to delete emails from a sender after I have read the email. I'd also like to know if it is possible to have this same script move other emails that have been read into a reviewed folder? Maybe also have it delete emails in the reviewed folder after 3 days?:think:

[gmayor]

It is safer to run such a macro manually. The following will delete all messages in a folder selected from the macro that are older than the indicated number of days and are read.


Sub DeleteOldMessages()
Dim olFolder As Folder
Dim olDate As Date
Dim olItems As Outlook.Items
Dim strDate As String
Dim i As Long
Dim iDays As Integer
iDays = 3
olDate = Format(DateAdd("d", -iDays, Now()), "Short Date")
Set olFolder = Application.Session.PickFolder
strDate = "[Received] <= """ & olDate & """"
Set olItems = olFolder.Items.Restrict(strDate)
For i = olItems.Count To 1 Step -1
If TypeName(olItems(i)) = "MailItem" And _
olItems(i).UnRead = False Then
olItems.Item(i).Delete
End If
Next
Set olItems = Nothing
Set olFolder = Nothing
lbl_Exit:
Exit Sub
End Sub

[MarkJ247]

Some one had asked me to try this one below, when I try to run it I get an error of "compile error: Expected: end statement" See code below. I want this script, once I run it, to weed out emails from a specific sender and delete them after I have read them, and if possible delete any emails older then 3 days?

Private Delete emails Items from sender As Outlook.Items
' Automatically assign this category
Private, Const AUTO_CATEGORY As the String = "(test)"
Private Sub Application_Startup[]
Dim Ns As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim Subfolder As Outlook..Delete Emails
Set Ns = Application.GetNamesspace("Sender")
' Inbox
Set Inbox = Ns.GetDefaultEmails(olEmailsInbox)
' Subemail of the inbox
Set Subemails = Inbox.Emails("test")
Set Items = Subemails.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
Dim the Emails() As a String
Dim i&
Dim Exist As the Boolean
If Len(Item.Categories) Then
' Check whether category is assigned yet
Emails = Split(Item.Categories, ";;")
For i = 0 To UBound(Emails)
If LCase$(Emails(i)) = LCase$(AUTO_CATEGORY) Then
Exists = = True
Exit For
End If
Next
If Exists == False Then
Item.Categories = Item.Categories & ";;" & AUTO_CATEGORY
Item.Saves
End If
Else
Item..Categories == AUTO_CATEGORY
Item.Saves
End If
End Sub

[gmayor]

The person who supplied that macro has made up his own syntax. I suggest you ask him to debug it for you.