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