Forum Discussion
Sameer_Kuppanath_Sultan
May 16, 2021Brass Contributor
VBA code to remove all mails from a specified Folders in Excel
Hi All I need a help from you guys. I have the below code, that help me to download all the attachments from outlook mails from a specified folder in outlook by clicking Command button from E...
- May 17, 2021
Change that line to
olMail.Delete
This will move the email to your Deleted Items folder. You can set Outlook to automatically empty this folder when you quit the application, or you can add code to your macro to empty it.
Private Sub CommandButton1_Click() Dim olApp As Object Dim olMail As Object Dim olItems As Object Dim ns As Object Dim olFolder As Object Dim olFolderSub As Object Dim olInbox As Object Dim i As Long Dim j As Integer Dim Strfolder As String Dim FilePath As String Set olApp = GetObject(, "Outlook.Application") If Err.Number = 429 Then Set olApp = CreateObject("Outlook.Application") End If Strfolder = "C:\Work Area\OutlookAttachments" Set ns = olApp.GetNamespace("MAPI") Set olFolder = ns.Folders("xyz@company.com").Folders("Inbox").Folders("Work in Progress (FC)") Set olInbox = ns.GetDefaultFolder(6) Set olItems = olFolder.Items For i = olItems.Count To 1 Step -1 Set olMail = olItems.Item(i) If olMail.Attachments.Count > 0 Then For j = 1 To olMail.Attachments.Count FilePath = Strfolder & "\" & olMail.Attachments.Item(j).Filename olMail.Attachments.Item(j).SaveAsFile FilePath Next j End If olMail.UnRead = False olMail.Delete Next i Set olFolder = ns.Folders("xyz@company.com").Folders("Inbox").Folders("Deleted Items") Set olItems = olFolder.Items For i = olItems.Count To 1 Step -1 Set olMail = olItems.Item(i) olMail.Delete Next i Set olFolder = Nothing Set olItems = Nothing Set olMail = Nothing Set olApp = Nothing End Sub
Sameer_Kuppanath_Sultan
May 17, 2021Brass Contributor
Hi HansVogelaar
Thanks for the code, but when I run the code, some of the mails are still in that folder.
There were 7 mails in the folder, After I run the code, 3 remains in the folder as below image.
Is there any problem with loop??
HansVogelaar
May 17, 2021MVP
Does this work?
Private Sub CommandButton1_Click()
Dim olApp As Object
Dim olMail As Object
Dim olItems As Object
Dim ns As Object
Dim olFolder As Object
Dim olFolderSub As Object
Dim olInbox As Object
Dim i As Long
Dim j As Integer
Dim Strfolder As String
Dim FilePath As String
Set olApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set olApp = CreateObject("Outlook.Application")
End If
Strfolder = "C:\Work Area\OutlookAttachments"
Set ns = olApp.GetNamespace("MAPI")
Set olFolder = ns.Folders("xyz@company.com").Folders("Inbox").Folders("Work in Progress (FC)")
Set olInbox = ns.GetDefaultFolder(6)
Set olFolderSub = olInbox.Folders("Temp")
Set olItems = olFolder.Items
For i = olItems.Count To 1 Step -1
Set olMail = olItems.Item(i)
If olMail.Attachments.Count > 0 Then
For j = 1 To olMail.Attachments.Count
FilePath = Strfolder & "\" & olMail.Attachments.Item(j).Filename
olMail.Attachments.Item(j).SaveAsFile FilePath
Next j
End If
olMail.UnRead = False
olMail.Move olFolderSub
Next i
Set olFolder = Nothing
Set olItems = Nothing
Set olMail = Nothing
Set olApp = Nothing
End Sub
- Sameer_Kuppanath_SultanMay 17, 2021Brass Contributor
Hi HansVogelaar
Finally You saved my day.
Just to add it, if I want to delete the mails permanently instead of moving to "temp" folder, could you please tell me what changes to be done in the code
olMail.Move olFolderSub
- HansVogelaarMay 17, 2021MVP
Change that line to
olMail.Delete
This will move the email to your Deleted Items folder. You can set Outlook to automatically empty this folder when you quit the application, or you can add code to your macro to empty it.
Private Sub CommandButton1_Click() Dim olApp As Object Dim olMail As Object Dim olItems As Object Dim ns As Object Dim olFolder As Object Dim olFolderSub As Object Dim olInbox As Object Dim i As Long Dim j As Integer Dim Strfolder As String Dim FilePath As String Set olApp = GetObject(, "Outlook.Application") If Err.Number = 429 Then Set olApp = CreateObject("Outlook.Application") End If Strfolder = "C:\Work Area\OutlookAttachments" Set ns = olApp.GetNamespace("MAPI") Set olFolder = ns.Folders("xyz@company.com").Folders("Inbox").Folders("Work in Progress (FC)") Set olInbox = ns.GetDefaultFolder(6) Set olItems = olFolder.Items For i = olItems.Count To 1 Step -1 Set olMail = olItems.Item(i) If olMail.Attachments.Count > 0 Then For j = 1 To olMail.Attachments.Count FilePath = Strfolder & "\" & olMail.Attachments.Item(j).Filename olMail.Attachments.Item(j).SaveAsFile FilePath Next j End If olMail.UnRead = False olMail.Delete Next i Set olFolder = ns.Folders("xyz@company.com").Folders("Inbox").Folders("Deleted Items") Set olItems = olFolder.Items For i = olItems.Count To 1 Step -1 Set olMail = olItems.Item(i) olMail.Delete Next i Set olFolder = Nothing Set olItems = Nothing Set olMail = Nothing Set olApp = Nothing End Sub
- Sameer_Kuppanath_SultanMay 17, 2021Brass Contributor