Forward Email #1

Sub Complete() ‘ Send Completed Message to support On Error Resume Next Dim oApp As Outlook.Application Dim objFolder As Outlook.MAPIFolder Set oApp = New Outlook.Application Set objNS = Application.GetNamespace(“MAPI”) Set objInbox = objNS.GetDefaultFolder(olFolderInbox) Set objFolder = objInbox.Folders(“Helpdesk”) Dim oEmail As Outlook.MailItem ‘Require that this procedure be called only when a message is selected If Application.ActiveExplorer.Selection.Count = 0 Then Exit Sub End If For Each objItem In Application.ActiveExplorer.Selection If objFolder.DefaultItemType = olMailItem Then If objItem.Class = olMail Then Response = MsgBox(“Forward message (” + item.Subject + “) to Appended Subject”) Set myForward = objItem.Forward myForward.Subject = “APPENDED SUBJECT – ” + objItem.Subject + “” myForward.Recipients.Add “Jimmy <jimmy.bharata@frieslandcampina.com>” myForward.Display ‘.Send or .Display End If End If Next End Sub

source : http://windowssecrets.com/forums/showthread.php/156624-Outlook-2010-VBA-Code-to-Forward-Email

Forward Email #2

Sub ForwardEmail(item As Outlook.MailItem)
Dim oMail As MailItem

On Error GoTo Release

Set oMail = item.Forward
oMail.Subject = oMail.Subject
oMail.HTMLBody = "Have a nice day." & vbCrLf & oMail.HTMLBody
oMail.Recipients.Add "email address here"

oMail.Send

Release:
Set oMail = Nothing

End Sub