Sub SendNew(Item As Outlook.MailItem)
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
objMsg.Recipients.Add "alias@domain.com"
If Item.Attachments.Count > 0 Then
CopyAttachments Item, objMsg
End If
objMsg.Send
End Sub
Sub CopyAttachments(objSourceItem, objTargetItem)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
strPath = fldTemp.Path & "\"
For Each objAtt In objSourceItem.Attachments
strFile = strPath & objAtt.FileName
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
fso.DeleteFile strFile
Next
Set fldTemp = Nothing
Set fso = Nothing
End Sub