Macro to forward active Outlook email without attachments

[DavidMontoya]

I am looking for assistance to create a VBA macro to forward active Outlook email without attachments.

Thank in advance for your assistance.

[gmayor]

How about


Sub FwdMsg()Dim olMsg As MailItem
Dim olNewMsg As MailItem
Dim i As Integer
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
Set olNewMsg = olMsg.Forward
For i = olNewMsg.Attachments.Count To 1 Step -1
olNewMsg.Attachments(i).Delete
Next i
olNewMsg.Display
lbl_Exit:
Set olMsg = Nothing
Set olNewMsg = Nothing
Exit Sub
End Sub

[DavidMontoya]

Graham, excellent!!!

Please allow me to ask an additional question related to this code. Is there a way to add:

Send to (email address)
Short body text
Automatically send the message

Thank a lot!

[gmayor]

The following adds that functionality

Sub FwdMsg()
' Graham Mayor - https://www.gmayor.com - Last updated - 11 May 2019
Dim olMsg As MailItem
Dim olNewMsg As MailItem
Dim olInsp As Inspector
Dim wdDoc As Object
Dim orng As Object
Dim i As Integer
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
Set olNewMsg = olMsg.Forward
With olNewMsg
.To = "email address of recipient"
For i = .Attachments.Count To 1 Step -1
.Attachments(i).Delete
Next i
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set orng = wdDoc.Range(0, 0)
orng.Text = "This is the text of the message you want to send." & vbCr & vbCr & _
"This text is placed before the default signature of the account."
.Display 'This line is necessary
'.Send 'Remove the apostrophe from the start of the line after testing
End With
lbl_Exit:
Set olMsg = Nothing
Set olNewMsg = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set orng = Nothing
Exit Sub
End Sub

[DavidMontoya]

Graham, it work very nice.

Thank you very much for your assistance!!!:clap::clap::clap: