Outlook2003 - eMail weiterleiten und Anhänge löschen

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"  
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"  
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function

Sub Empfänger1()

Dim objMail As Outlook.MailItem

Set objItem = GetCurrentItem()
Set objMail = objItem.Forward
objMail.To = "empfänger1@intern.de"  
objMail.Send
objItem.Delete
Set objItem = Nothing
Set objMail = Nothing

End Sub