May times it happens that you want to forward some mail without attachment that you received with attachments, and you need to delete manually. Following function will help you to remove the attachment while you send mail to someone.
Sub ForwardMailWithoutAttachment()
On Error GoTo ErrorHandler
Dim obj As Object
Dim msg As Outlook.MailItem
Dim newMsg As Outlook.MailItem
Dim subject As String
Dim myattachments As Outlook.Attachments
' check for multiple selections
If ActiveExplorer.Selection.Count > 1 Then
MsgBox "please select one email only"
GoTo ProgramExit
End If
Set obj = ActiveExplorer.Selection.Item(1)
If Not obj Is Nothing Then
If TypeName(obj) = "MailItem" Then
Set msg = obj
Set newMsg = msg.Forward
subject = obj.subject ' Copy the selected Mail Subject
If Len(subject) = 0 Then
GoTo ProgramExit
End If
'########### To Remove the Attachment ##############
Set myattachments = newMsg.Attachments
While myattachments.Count > 0
myattachments.Remove 1
Wend
'###########################################
With newMsg
.subject = subject
.Display
End With
Else
MsgBox "Cannot Run this Macro. Invalid Selection of Mail."
GoTo ProgramExit
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Sub ForwardMailWithoutAttachment()
On Error GoTo ErrorHandler
Dim obj As Object
Dim msg As Outlook.MailItem
Dim newMsg As Outlook.MailItem
Dim subject As String
Dim myattachments As Outlook.Attachments
' check for multiple selections
If ActiveExplorer.Selection.Count > 1 Then
MsgBox "please select one email only"
GoTo ProgramExit
End If
Set obj = ActiveExplorer.Selection.Item(1)
If Not obj Is Nothing Then
If TypeName(obj) = "MailItem" Then
Set msg = obj
Set newMsg = msg.Forward
subject = obj.subject ' Copy the selected Mail Subject
If Len(subject) = 0 Then
GoTo ProgramExit
End If
'########### To Remove the Attachment ##############
Set myattachments = newMsg.Attachments
While myattachments.Count > 0
myattachments.Remove 1
Wend
'###########################################
With newMsg
.subject = subject
.Display
End With
Else
MsgBox "Cannot Run this Macro. Invalid Selection of Mail."
GoTo ProgramExit
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Hi,
ReplyDeleteHow would this work if I wanted to add some new text above the original message? Say "Please respond to this earlier e-mail"?
BR
Russell
This function will open forward message without attachment, you can put text as required.
Delete