So as to ensure that your outgoing emails have been delivered successfully, you can request the delivery receipts. In this case, your mailbox may be stuffed with a lot of such receipts. To batch delete them permanently, you can use the way shared in this post.
My previous post “How to Batch Delete All Receipts in Your Outlook” has shared an effective method to delete all receipts, no matter the delivery, undeliverable or read receipts. But, sometimes, you may want to delete the delivery receipts only. To cope with this requirement, here we will expose another piece of VBA code to you.
Batch Delete All Delivery Receipts in Outlook
- At the very outset, get into Outlook VBA editor.
- Then, copy and paste the following code into a module.
Dim objOutlookFile As Outlook.Folder Sub BatchDeleteAllDeliveryReceipts() Dim objStore As Outlook.Store Dim objFolder As Outlook.Folder Dim lTotalCount As Long lTotalCount = 0 'Process all Outlook files For Each objStore In Outlook.Application.Session.Stores Set objOutlookFile = objStore.GetRootFolder For Each objFolder In objOutlookFile.Folders If objFolder.DefaultItemType = olMailItem Then Call ProcessFolders(objFolder, lTotalCount) End If Next Next 'Prompt you of the results MsgBox lTotalCount & " delivery receipts are deleted!", vbInformation + vbOKOnly End Sub Sub ProcessFolders(ByVal objCurrentFolder As Outlook.Folder, lCount As Long) Dim i As Long Dim objDeliveryReceipt As Outlook.ReportItem Dim objSubfolder As Outlook.Folder Dim objDeletedItems As Outlook.Items Dim objItem As Object For i = objCurrentFolder.Items.Count To 1 Step -1 'Find delivery receipts If (TypeOf objCurrentFolder.Items(i) Is ReportItem) And (Left(objCurrentFolder.Items(i).Subject, 10) = "Delivered:") Then Set objDeliveryReceipt = objCurrentFolder.Items.Item(i) objDeliveryReceipt.Delete lCount = lCount + 1 'Permanently delete them Set objDeletedItems = objOutlookFile.Folders("Deleted Items").Items For Each objItem In objDeletedItems If (TypeOf objItem Is ReportItem) And (Left(objItem.Subject, 10) = "Delivered:") Then objItem.Delete End If Next End If Next 'Loop subfolders recursively If objCurrentFolder.Folders.Count > 0 Then For Each objSubfolder In objCurrentFolder.Folders Call ProcessFolders(objSubfolder, lCount) Next End If End Sub
- Afterwards, click into the first subroutine and press “F5” key button.
- At once, the macro will work.
- When it finishes, you’ll get a message about how many delivery receipts have been deleted forever from your mailboxes in Outlook, like the screenshot.
Never Fear Outlook Data Damage
Some users keep concerned about their Outlook data, fearing data corruption. In fact, as long as you take the following actions, you can get rid of such concern. In the first place, you should make regular data backups for your Outlook. Thereby, even if Outlook file gets damaged, you still can recover Outlook from backups in a jiffy. Also, you can resort to a potent external fix tool, such as DataNumen Outlook Repair to repair damaged PST file.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including SQL Server repair and outlook repair software products. For more information visit www.datanumen.com