Use this macro to send an attachment to email addresses in the To line and CC others with just the message.
Work in progress: the attachment script needs to be changed to save it to a file share.
Sub CCNoAttachments() Dim objApp As Outlook.Application Dim objMsg As Outlook.MailItem Dim oItem As Object Set objApp = Application Set objMsg = Application.CreateItem(olMailItem) Set oItem = objApp.ActiveInspector.CurrentItem CopyAttachments oItem, objMsg objMsg.CC = oItem.CC objMsg.Subject = oItem.Subject objMsg.Body = objMsg.Body & "Sent to: " & oItem.To & vbCrLf & vbCrLf & oItem.Body ' This results in a nicely formatted body but may not work well if you use RTF or plain text ' objMsg.HTMLBody = objMsg.Body & " Sent to: " & oItem.To & vbCrLf & vbCrLf & oItem.HTMLBody objMsg.Display ' Remove CC addresses oItem.CC = "" Set objMsg = Nothing Set oItem = Nothing 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 ' include the filename, although if you only want to use the filename, using ' oItem.Attachments.Item(i).FileName in the main macro would be better objTargetItem.Body = "Included file: " & objAtt.FileName ' include the full path to the file ' objTargetItem.Body = "Included file: " & strFile Next Set fldTemp = Nothing Set fso = Nothing End Sub
Create the second message on Send
This macro looks at all messages you send and any message that contains an attachment is processed. The CC'd members receive a copy of the message with the attachment filename(s) and a list of people the message was sent to.
Note: This macro applies to all messages with attachments, which includes images in signatures.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim objApp As Outlook.Application Dim objMsg As Outlook.MailItem Dim i As Long Dim strFile As String Set objApp = Application Set objMsg = Application.CreateItem(olMailItem) If Item.Attachments.Count > 0 Then For i = 1 To Item.Attachments.Count strFile = Item.Attachments.Item(i).FileName & "; " & strFile Next i objMsg.CC = Item.CC objMsg.Subject = Item.Subject objMsg.HTMLBody = strFile & " Sent to: " & Item.To & vbCrLf & vbCrLf & Item.HTMLBody objMsg.Send ' Remove CC addresses Item.CC = "" ' End If End If Set objMsg = Nothing End Sub
Thank you, Diane. By "Notify" I meant adding text "Attachments were removed" to the forwarded message body if it had attachments before.
Two questions:
1. Will your script leave the attachments in the original email box and remove only in forwarded message? I would like remove attachments only in forwarded message.
2. Should I add your suggested script right after "Sub AutoForwardAllSentItems(Item As Outlook.MailItem)" line?
You can either check for attachments.count > 0 and add text that says 'attachments were removed' or use a more complicated macro that checks the size of at least one attachment - you could add the name of the attachment too.
I'd probably check the size at least, because an image in a signature is an attachment.
Something like
if oItem.Attachments.count > 0 then
For Each oAtt In oItem.Attachments
If oAtt.Size > 5200 Then
strAtt = "attachments removed"
Goto NextStep 'to exit this part, since we know at least one attachment is larger
End if
Next oAtt
end if
NextStep:
'reset of macro
1. Yes, the macro will only remove attachments from the forward, it's possible to remove them from the original message though too.
2. No, you should kind of merge them - using just the pieces you need.
Diane,
How to modify forwarding script below that it would forward emails without attachments and notify if attachments were removed?
Sub AutoForwardAllSentItems(Item As Outlook.MailItem)
Dim strMsg As String
Dim myFwd As Outlook.MailItem
Set myFwd = Item.Forward
myFwd.Recipients.Add "my10digitPhone@tmomail.net"
myFwd.Send
Set myFwd = Nothing
End Sub
Define "Notify" :) I have a macro at https://www.slipstick.com/developer/code-samples/insert-attachment-names-replying/ which adds the attachment name to a reply.
To delete attachments, you need something like this:
Set myAttachments = myItem.Attachments
lngAttachmentCount = myAttachments.count
' Loop through attachments until attachment count = 0.
While lngAttachmentCount > 0
myAttachments(1).Delete
lngAttachmentCount = myAttachments.count
Wend
Diane, I was trying to use your Code for "No attachments to CC'd Recipients), and when I created it in Outlook, and run it, it stops at Set oItem = objApp.ActiveInspector.CurrentItem with the message "Object variable or With block variable not set". How wouold I fix this?
That means there is a typo in the code. It's odd that it stops there. You are running this with the message open on screen?