VBA Code to permanently delete selected email

Status
Not open for further replies.

RayB

Member
Outlook version
Email Account
POP3
Hello,

I just moved to Outlook 2007 when my Windows Live Mail died. After all the fun in moving everything I am looking for some help. I find myself using the shift+delete and return to permanently delete an email. I see lots of suggestions to delete the email and then empty the deleted items folder based on something. I have established that I keep selected deleted emails for some time and then delete them as necessary, however I do not want to clutter the deleted folder with emails that I know when I read them that I do not want to keep. I found that using the laptop built in keyboard also has some issues when I am using the shift+delete buttons. So I am thinking about adding a button that would permanently delete the selected email and thus make things much simpler.

I am new to VBA and thought I might ask here. Also is there is an easier way to accomplish this please suggest it but not if it follows the solution stated above.

Thank you in advance for your help!
 
You don't need VBA - use a Quick step instead. Oh, 2007 doesn't have quick Steps. :( If you don't need the messages deleted immediately, you can use AutoArchive to delete mail in the deleted items and junk folder as they age.

A macro cant delete permanently, it needs to move to deleted folder, then delete.

This appears to work here - if Delete doesn't work, then move to the deleted folder and delete. Its deleting anything moved within the last min - use 1 / 2880 for 30 seconds. Works best if there aren't many messages in the deleted items folder.

Code:
Sub PermDelete()

    Dim myOlApp, myNameSpace, Sel, objRecip As Object
    Dim MyItem As Object
    Dim MyItem1 As Outlook.MailItem
    Dim DeletedFolder As Object
    Dim objProperty As Object
    Dim SavedEntryId, i

    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set Sel = Application.ActiveExplorer.Selection
    Set DeletedFolder = myNameSpace.GetDefaultFolder(olFolderDeletedItems)

    For i = 1 To Sel.Count
        If Sel.Item(i).Class = olMail Then
            Set MyItem = Sel.Item(i)
            MyItem.Delete ' Move DeletedFolder
        End If
    Next

   Dim obj As Object
 
    For Each obj In DeletedFolder.Items
   
        If DateDiff("N", obj.LastModificationTime, Now) < 1 / 1440 Then
                obj.Delete
            End If
    Next
End Sub
 
Last edited:
use 1 / 2880 for 30 seconds.
You can use another number - it seemed to work ok with 30 seconds (could be user error though- i have 2000+ items in the deleted folder and could have missed something.) I know it deletes recent items - you might be limited to deleting everything new in the last min.

If this is a problem, you could add a category and only delete items in that category - this actually might be a better way anyway.

Code:
Sub DeleteCategories()

    Dim myOlApp, myNameSpace, Sel, objRecip As Object
    Dim MyItem As Object
    Dim MyItem1 As Outlook.MailItem
    Dim DeletedFolder As Object
    Dim objProperty As Object
    Dim SavedEntryId, i

    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set Sel = Application.ActiveExplorer.Selection
    Set DeletedFolder = myNameSpace.GetDefaultFolder(olFolderDeletedItems)

    For i = 1 To Sel.Count
        If Sel.Item(i).Class = olMail Then
            Set MyItem = Sel.Item(i)
            MyItem.Categories = "DeleteMe"
            MyItem.Move DeletedFolder
        End If
    Next

   Dim obj As Object

    For Each obj In DeletedFolder.Items
        If obj.Categories = "DeleteMe" Then
                obj.Delete
            End If
    Next
End Sub
 
Hi Diane,

Thank You for your prompt reply. I have messed around with VBA in Excel but never ventured into Outlook. Very different. I decided as you suggested to add a new folder to avoid dealing with the Deleted Folder and causing issues. I called the new folder Perm Delete (no underscore between the words just a space). I then modified the code you graciously wrote (I don't think I would have ever gotten there) as shown below.

Sub DeleteCategories()

Dim myOlApp, myNameSpace, Sel, objRecip As Object
Dim MyItem As Object
Dim MyItem1 As Outlook.MailItem
Dim PermDeleteFolder As Object
Dim objProperty As Object
Dim SavedEntryId, i

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set Sel = Application.ActiveExplorer.Selection
Set Perm Delete = myNameSpace.GetDefaultFolder(olFolderPerm Delete)

For i = 1 To Sel.Count
If Sel.Item(i).Class = olMail Then
Set MyItem = Sel.Item(i)
MyItem.Categories = "DeleteMe"
MyItem.Move Perm Delete Folder
End If
Next

Dim obj As Object

For Each obj In Perm Delete Folder.Items
If obj.Categories = "DeleteMe" Then
obj.Delete
End If
Next
End Sub

I then opened the VB Editor added a module and pasted the code in. I decided to Step through the code so I could watch what was happening and received this error Run Time Error '429' ActiveX component cannot create object which is associated with this line : Set myOlApp = CreateObject("Outlook.Application")

I have included a screen shot of the VB Editor below:

1524931825238.png


So how do I fix this error and do you see any other errors in my code?

Thank you again for your help!

Ray
 
Code:
Set Perm Delete = myNameSpace.GetDefaultFolder(olFolderPerm Delete)

This is not how you reference non-default folders. See Working with VBA and non-default Outlook Folders - you'll use something like this- the Perm Delete folder is a subfolder under Inbox in this example:
Set PermDelete = myNameSpace.GetDefaultFolder(olFolderInbox).Folders.("Perm Delete")
 
Hi again,

I have updated the code based on the reference and here it is:

Sub PermDelete()


Dim muOlApp, myNameSpace, Sel, objRecip As Object
Dim MyItem As Object
Dim MyItem1 As Outlook.MailItem
Dim PermDeleteFolder As Object
Dim objProperty As Object
Dim SavedEntryId, i

Set myOlApp = CreateObject("Outlook.Application")

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set Sel = Application.ActiveExplorer.Selection
Set PermDeleteFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Folder("Perm Delete")

For i = 1 To Sel.Count
If Sel.Item(i).Class = olMail Then
Set MyItem = Sel.Item(i)
MyItem.Move PermDeleteFolder
End If
Next

Dim obj As Object
For Each obj In PermDeleteFolder.Items

If DateDiff("N", obj.LastModificationTime, Now) < 1 / 1440 Then
obj.Delete
End If
Next
End Sub

Unfortunately when I try to run the macro I get Runtime error #429 Active X component cannot create object on the line
Set myOlApp = CreateObject("Outlook.Application")

I have searched the web and tried many suggestions about code changes but nothing seems to work. There were also suggestions about newer Outlook versions installed over older ones however this is not true for me.

Does anyone have a real solution to this problem?

I am sorry what seemed to be such a simple thing has grown into such a beast.... :confused:

Thanks in advance for your help!
 
Hi Diane,

I messed around with the code some more and got it to work. Here is where ended up:

Sub PermDelete()

'Usage: Permanently delete mail items
'How to use: select the mail items; execute this macro

Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim Sel As Selection
Dim MyItem As Object
Dim DeletedFolder As Outlook.Folder
Dim i As Integer

Set myOlApp = Outlook.Application
Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set Sel = Application.ActiveExplorer.Selection

For i = Sel.Count To 1 Step -1 'Process in reverse order so as not to screw up the count
Set MyItem = Sel(i)
MyItem.Categories = "DeleteMeNow"
MyItem.Save
MyItem.Delete ' Places message in the Deleted Items folder
Next

Dim obj As Object

For Each obj In DeletedFolder.Items
If obj.Categories = "DeleteMe" Then
obj.Delete
End If
Next


It works but it takes forever to check each email in the deleted folder. The same is true if I use the date/time modified you suggested. I believe this is because it starts with the oldest email and searches through them until it reaches the most current ones and then deletes them permanently.

Is it possible to turn this search around and start with the most current email, and then only process the 50 most current emails in the Deleted Folder, and if the Category = "DeleteMe" then delete it?

Thank you for your help!
 
Sort the Items collection descending before the loop starts
Code:
deletedfolder.items.sort "[Receivedtime]", true
Then use a For i=1 to 50 loop instead of For Each.
 
Hi,

Here is my attempt at using a For i = 50 loop at the end of the sub to permanently delete the email from the Deleted Folder:

Sub PermDelete()

'Usage: Permanently delete mail items
'How to use: select the mail items; execute this macro

Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim Sel As Selection
Dim MyItem As Object
Dim DeletedFolder As Outlook.Folder
Dim i As Integer

Set myOlApp = Outlook.Application
Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set Sel = Application.ActiveExplorer.Selection

For i = Sel.Count To 1 Step -1 'Process in reverse order so as not to screw up the count
Set MyItem = Sel(i)
MyItem.Categories = "DeleteMeNow"
MyItem.Save
MyItem.Delete ' Places message in the Deleted Items folder
Next

Set DeletedFolder = myNameSpace.GetDefaultFolder(olFolderDeletedItems)

DeletedFolder.Items.Sort "[Receivedtime]", True

For i = 1 To 50


If DeletedFolder.Items.Item(i).obj.Categories = "DeleteMeNow" Then
DeletedFolder.Items.Item(i).obj.Delete
End If

Next

End Sub

However, I get a Run Time error 438 Object doesn't support this property or method on the line:


If DeletedFolder.Items.Item(i).obj.Categories = "DeleteMeNow" Then
DeletedFolder.Items.Item(i).obj.Delete

The vba for outlook is very confusing and searching the www has only confused me more. How can this code be fixed? I trust that the Deleted folder sort works since I did not get an error but it looks the same as it was before the sort.

I appreciate your help!
 
"obj" is a variable you´d used with the For Each loop. It is not a property of Item(i). The loop will be faster if you use variables so that every object has to be referenced as less as possible:
Code:
dim items as outlook.items
set items=deletedfolder.items
for i....
set obj=items(i)
if obj.categories...
...
 
Hi,

Thank You for helping me with the items information. After modifying the code to include it the macro still did not delete the item from the Deleted Items folder. I think the sort function worked but the next steps started at the oldest email first. After some digging I learned about counting the items in a folder and then using that count to count down from the highest (that is newest email added) through the previous 50. That worked perfectly.

I have posted the final code below.

Thank you all again!

Sub PermDelete()

'Usage: Permanently delete mail items
'How to use: select the mail items; execute this macro

Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim Sel As Selection
Dim MyItem As Object
Dim DeletedFolder As Outlook.Folder
Dim i As Integer, Count As Long
Dim items As Outlook.items

Set myOlApp = Outlook.Application
Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set Sel = Application.ActiveExplorer.Selection

For i = Sel.Count To 1 Step -1 'Process in reverse order so as not to screw up the count
Set MyItem = Sel(i)
MyItem.Categories = "DeleteMeNow"
MyItem.Save
MyItem.Delete ' Places message in the Deleted Items folder
Next

Set DeletedFolder = myNameSpace.GetDefaultFolder(olFolderDeletedItems)
Set items = DeletedFolder.items
Count = items.Count

For i = Count To Count - 50 Step -1
Set obj = items(i)
If obj.Categories = "DeleteMeNow" Then
obj.Delete
End If
Next

End Sub
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
D Outlook 2021 Using vba code to delete all my spamfolders not only the default one. Outlook VBA and Custom Forms 0
K vba code to auto download email into a specific folder in local hard disk as and when any new email arrives in Inbox/subfolder Outlook VBA and Custom Forms 0
D VBA code to select a signature from the signatures list Outlook VBA and Custom Forms 3
S Excel vba code to manage outlook web app Using Outlook 10
S Outlook VBA How to adapt this code for using in a different Mail Inbox Outlook VBA and Custom Forms 0
S Add VBA save code Using Outlook 0
C Auto Run VBA Code on new email Outlook VBA and Custom Forms 1
F VBA code to dock Styles whenever I write or edit an email Outlook VBA and Custom Forms 0
S Skype for business meeting vba code Outlook VBA and Custom Forms 1
R Expand VBA Permanent Delete Code Outlook VBA and Custom Forms 6
B Outlook Business Contact Manager with SQL to Excel, User Defined Fields in BCM don't sync in SQL. Can I use VBA code to copy 1 field to another? BCM (Business Contact Manager) 0
A VBA Code in Outlook disappears after first use Outlook VBA and Custom Forms 1
F VBA to ensure a code is entered in Subject title Outlook VBA and Custom Forms 1
N Open & Save VBAProject.Otm using VBA Code Outlook VBA and Custom Forms 1
C Need VBA code to automatically save message outside outlook and add date Outlook VBA and Custom Forms 1
S VBA Code to move mail items from search folder to inbox subfolder Outlook VBA and Custom Forms 4
B VBA Code to create appointment from email Outlook VBA and Custom Forms 1
D VBA Code to strip Subject Line when replying or forwarding Using Outlook 3
M VBA Code to Restart Outlook on error Outlook VBA and Custom Forms 3
Z Default VBA code for extracting data from email (Outlook) to Excel? Outlook VBA and Custom Forms 1
T VBA to Sort Rules [A-Z] - code provided Outlook VBA and Custom Forms 9
M VBA Auto-Reply code for Two Mailboxes on one Outlook Session. Outlook VBA and Custom Forms 4
Z Protecting VBA code - anything new? Outlook VBA and Custom Forms 2
G VBA code to enable a rule based on time of day for a IMAP mail account Outlook VBA and Custom Forms 14
S VBA code to rename a task (flagged message) Outlook VBA and Custom Forms 1
M VBA code to save email attachments (PDF) as email subject line Outlook VBA and Custom Forms 1
F VBA Code to change subject Like Outlook VBA and Custom Forms 3
Diane Poremsky Pasting VBA code (and other editing) Outlook VBA and Custom Forms 4
C Required VBA code to complete task when replied to Outlook VBA and Custom Forms 2
Kelli VBA code for Outlook Using Outlook 1
S Requried a VBA Code to export Calander details to excel... Outlook VBA and Custom Forms 4
M VBA Code to extract data from an Outlook Form Using Outlook 0
M VBA code needed to move from Outlook 2010 subfolder to Symantec Vault subfolde Using Outlook 0
C In need of VBA code to read / parse HTML - Outlook emails Using Outlook 0
R [VBA] complicated(?) outlook events - need help with code Using Outlook 15
R how to get Outlook VBA code to work on the current folder Using Outlook 3
J VBA code can't be completely executed in outlook 2013 Using Outlook 0
D VBA: Send-From Code for Template Shortcut? Using Outlook 0
P VBA Code being completely ignored by Outlook Using Outlook 7
M Updating VBA code from outlook 2007 to outlook 2010 Using Outlook 1
J VBA code to determine 'show' state of SearchBar Using Outlook 7
D VBA code running on Server? Shared mailbox email routing Using Outlook 3
L Send E-mail with VBA code from [E-mail Distribution Group] if I have “Send as” Using Outlook 6
S Outllok 2007 VBA code to send mail automatically from drafts folder Using Outlook 1
S ThisOutlookSession in VBA not there anymore and code is gone Using Outlook 2
F No Attachment Warning - VBA Code HELP Outlook VBA and Custom Forms 1
J VBA code (rules) won't work after reboot Outlook VBA and Custom Forms 2
N VBA code to show today's date + a sequencial number in subject lin Outlook VBA and Custom Forms 1
A Accessing .pst folder in outlook using VBA Code Outlook VBA and Custom Forms 4
C Beginner Needs VBA Help in Modifying Code Outlook VBA and Custom Forms 2

Similar threads

Back
Top