Reply All with Email History and Copy Original Attachments

agent_maxine

New Member
Joined
Aug 23, 2017
Messages
38
Dear Mr. Excel,

I have the following codes that attempt to do the following, once an email is selected in MS Outlook:

  1. Include all the recipients in the selected email
  2. Copy the original attachments that came in the selected email
  3. Reply with a designated text, along with default signature and email history

#1~2 work well, until it gets to #3 --> Run-Time Error 287: Application-Defined or Object-Defined Error
.HTMLBody = "Hello" & vbNewLine & .HTMLBody

The curious thing is, this code works just fine on a different computer.

Code:
Sub ReplyAll_Attachments()

MsgBox "Please make sure that you have selected the email to Reply All."

Dim outlookApp As Outlook.Application, outlookMail As Outlook.MailItem, outlookReply As Outlook.MailItem
Dim outlookItem As Object, Signature As String, strBody As String
    Set outlookApp = New Outlook.Application
    Set outlookMail = outlookApp.CreateItem(0)
    Set outlookItem = GetCurrentItem()

'On Error Resume Next
'On Error GoTo 0

'Get Default Email Signature
Signature = Environ("appdata") & "\Microsoft\Signatures\"

If Dir(Signature, vbDirectory) <> vbNullString Then
        Signature = Signature & Dir$(Signature & "*.htm")
    Else:
        Signature = ""
End If

Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).readall

'Create Email
'outlookMail.HTMLBody = Signature

If Not outlookItem Is Nothing Then
    Set outlookReply = outlookItem.ReplyAll
    With outlookReply
    .Subject = "Replying to " & outlookItem.Subject
    .HTMLBody = "Hello" & vbNewLine & .HTMLBody
    CopyAttachments outlookItem, outlookReply 'Copy Attachments from the Selected Email to Reply
    .Display
    outlookItem.UnRead = False
End With
End If

Set outlookReply = Nothing
Set outlookItem = Nothing

End Sub


Function GetCurrentItem() As Object

Dim objApp As Outlook.Application
Set objApp = Outlook.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) 'Temporary Folder

    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
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Forum statistics

Threads
1,213,489
Messages
6,113,954
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top