Outlook 2013 Needing help with reply/reply all while keeping attachments and adding a new CC recipient.

broadbander

Member
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server
I was wanting to see if there is a way to Reply to the sender of an e-mail in Outlook 2013 while attaching all the attachments that the sender sent while adding a carbon copy of a new recipient?

I know the following code can either Reply or Reply All, but I am having an issue trying to figure out the carbon copy, I don't have an issue with the Outlook security window showing up. I've tried using other vba examples to CC an address, but they all fail and I am suspecting perhaps it has to do with the first part below of "Set rpl = itm.ReplyAll".

Any ideas on how I can use reply/all to send attachments, keeping the e-mail chain complete and add a new recipient to the CC box?

Sub ReplyWithAttachments()
Dim rpl As Outlook.MailItem
Dim itm As Object

Set itm = GetCurrentItem()
If Not itm Is Nothing Then
Set rpl = itm.ReplyAll
CopyAttachments itm, rpl
rpl.Display
End If

Set rpl = Nothing
Set itm = Nothing
End Sub

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
End Select

Set objApp = Nothing
End Function

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
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
This is creating the message:
Set rpl = itm.ReplyAll
CopyAttachments itm, rpl
rpl.Display

since there are no addresses in the BCC field, you can use this (it erases the values already there):
rpl.bcc = "alias@domain.com"

The other way is using the recipients collection. You'd have to use this method to add to existing addresses, as it adds, not replaces (but it works to add the only address too):
Dim objRecip As Recipient
Set objRecip = rpl.Recipients.Add("alias@domain.com")
objRecip.Type = olBCC

in either case it goes before .display
 

broadbander

Member
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server
Thank you for the response!

Oddly if I use the below with added code, the macro doesn't execute at all. if I remove the three lines of code, it executes with the reply and attachments being added. If I try with just rpl.BCC = "alias@domain.com", the macro won't process until I remove it. Am I entering it wrong?


Sub ReplyWithAttachments()
Dim objRecip As Recipient
Dim rpl As Outlook.MailItem
Dim itm As Object

Set objRecip = rpl.Recipients.Add("user@domain.com")
objRecip.Type = olBCC

Set itm = GetCurrentItem()
If Not itm Is Nothing Then
Set rpl = itm.ReplyAll
CopyAttachments itm, rpl
rpl.Display
End If

Set rpl = Nothing
Set itm = Nothing
End Sub

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
End Select

Set objApp = Nothing
End Function

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
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
it took me a while to see the error - you need the dim at the top (ok) and the other stuff after you set the reply object, not before.
put this right before .display:
Set objRecip = rpl.Recipients.Add("user@domain.com")
objRecip.Type = olBCC
rpl.Display
End If
 

broadbander

Member
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server
Well.. nevermind.. it looks like rpl.BCC = "alias@domain.com" started working on its own... as did the second way! Thank you for all the help! Perfect!
 

broadbander

Member
Outlook version
Outlook 2013 32 bit
Email Account
Exchange Server
it took me a while to see the error - you need the dim at the top (ok) and the other stuff after you set the reply object, not before.
put this right before .display:
Set objRecip = rpl.Recipients.Add("user@domain.com")
objRecip.Type = olBCC
rpl.Display
End If
Thank you for that! I was playing with it likely alongside you without realizing it! Thank you very much Diane!
 

Similar threads

Top