steve tatum
New Member
- Outlook version
- Outlook 2016 32 bit
- Email Account
- Exchange Server 2013
Hello, I need a little Outlook VBA help please...I manually select a subfolder from a main folder that I created (not inbox, sent, delete, etc.) in my left-hand folder pane in Outlook and run this code to delete email messages contained in the folder. However, I have about 50 folders that I need to do this to. Can someone tell me how to change this code so it will automatically "scroll" through 50 subfolders and delete the emails in each of those folders one folder at a time? I would like to manually select the main folder and run code to automatically select each subfolder under it and then delete email messages in those folders.
Sub DeleteEmails()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim subfolder As Outlook.Folder
Dim subfolders As Outlook.folders
Dim folders As Outlook.folders
Dim namespace As Outlook.namespace
' Set Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set namespace = objOL.GetNamespace("MAPI")
Set Folder = Application.ActiveExplorer.CurrentFolder
On Error Resume Next
If Not Folder.Item(i) Is Nothing Then
For Each objMsg In Folder.Items
objMsg.Deleted
Next objMsg
End If
End Sub
Sub DeleteEmails()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim subfolder As Outlook.Folder
Dim subfolders As Outlook.folders
Dim folders As Outlook.folders
Dim namespace As Outlook.namespace
' Set Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set namespace = objOL.GetNamespace("MAPI")
Set Folder = Application.ActiveExplorer.CurrentFolder
On Error Resume Next
If Not Folder.Item(i) Is Nothing Then
For Each objMsg In Folder.Items
objMsg.Deleted
Next objMsg
End If
End Sub