NarR
03-29-2017, 06:33 AM
Hello,
i have a vba-script to delete all Recipients in order to get very small Emails. We often have emails that go to 50-300 people, therefore the Emails reaches fastly 1Mb or even 9Mb.
The code is very simple, go thru each Recipient and delete one after another.
But this way i have 2 Problems:
- it is very slow --> how can i make it faster, like "remove_all".
- if i have recipients in "to" and "CC" then the Emails doesnt get that small. I dont know why. How can i fix it?
Sub DeleteRecipients()
'Declaration
Dim myItems, myItem, myRecipients As Object
Dim myOrt, myTextRemovedBody, myTextRemovedHTMLBody, myTextRemovedSubject As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
On Error Resume Next
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'for all items do...
For Each myItem In myOlSel
Set myRecipients = myItem.Recipients
Do Until myRecipients.Count = 0
'remove it (use this method in Outlook XP)
myRecipients.Remove (1)
'remove it (use this method in Outlook 2000)
'myRecipients(1).Delete
Loop
'save item without recipients
myItem.Save
Next 'myItem
End Sub
i have a vba-script to delete all Recipients in order to get very small Emails. We often have emails that go to 50-300 people, therefore the Emails reaches fastly 1Mb or even 9Mb.
The code is very simple, go thru each Recipient and delete one after another.
But this way i have 2 Problems:
- it is very slow --> how can i make it faster, like "remove_all".
- if i have recipients in "to" and "CC" then the Emails doesnt get that small. I dont know why. How can i fix it?
Sub DeleteRecipients()
'Declaration
Dim myItems, myItem, myRecipients As Object
Dim myOrt, myTextRemovedBody, myTextRemovedHTMLBody, myTextRemovedSubject As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
On Error Resume Next
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'for all items do...
For Each myItem In myOlSel
Set myRecipients = myItem.Recipients
Do Until myRecipients.Count = 0
'remove it (use this method in Outlook XP)
myRecipients.Remove (1)
'remove it (use this method in Outlook 2000)
'myRecipients(1).Delete
Loop
'save item without recipients
myItem.Save
Next 'myItem
End Sub