Sub ForwardSelectedMessages()
'Graham Mayor - https://www.gmayor.com - Last updated - 01 Dec 2019
'Forwards the currently selected messages
Const strTo As String = "someone@somewhere.com"    'recipient
Const strBody As String = "Please see message below."    'Covering message
Const strCC As String = ""    'CC recipients(s) if required
Dim sPath As String
Dim olItem As MailItem
Dim olFwd As MailItem
Dim olInsp As Inspector
Dim wdDoc As Object
Dim oRng As Object

    For Each olItem In Application.ActiveExplorer.Selection
        If olItem.Class = OlObjectClass.olMail Then
            Set olFwd = olItem.Forward
            With olFwd
                .To = strTo
                .CC = strCC
                .Display
                .BodyFormat = olFormatHTML
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                oRng.Text = strBody
                '.Send 'remove apostrophe after testing
            End With
        End If
    Next olItem
lbl_Exit:
    Set olItem = Nothing
    Set olFwd = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub