How to reply email with attachment

Creation date: 3/16/2023 9:58 AM    Updated: 3/16/2023 9:58 AM

1/ Activate the Macro settings (ALT + F11), click on Visual basic then on Project1, then on Microsoft Outlook and then on ThisOutlookSession.


2/ Second, Copy Paste this program in visual macro basic:

Sub ReplyAllWithAttachments()

'Updateby Extendoffice

Dim xItem As Object

On Error Resume Next

Select Case TypeName(Outlook.Application.ActiveWindow)

Case "Explorer"

For Each xItem In Outlook.Application.ActiveExplorer.Selection

GetReplyItem xItem

Next

Case "Inspector"

Set xItem = Outlook.Application.ActiveInspector.CurrentItem

GetReplyItem xItem

End Select

Set xItem = Nothing

End Sub

Sub GetReplyItem(Item As Object)

Dim xReplyMailItem As Outlook.MailItem

On Error Resume Next

If Not Item Is Nothing Then

Set xReplyMailItem = Item.ReplyAll

GetAttachments Item, xReplyMailItem

xReplyMailItem.Display

'xReplyMailItem.Send

Item.UnRead = False

End If

Set xReplyMailItem = Nothing

End Sub

Sub GetAttachments(xSourceItem, xTargetItem)

Dim xFSO As Scripting.FileSystemObject

Dim xTmpPath As String

Dim xAttachment As Attachment

Dim xTmpFile As String

On Error Resume Next

Set xFSO = New Scripting.FileSystemObject

xTmpPath = CreateObject("shell.Application").NameSpace(5).self.Path & "\TmpAttachments\"

If xFSO.FolderExists(xTmpPath) = False Then

MkDir xTmpPath

End If

For Each xAttachment In xSourceItem.Attachments

If IsEmbeddedAttachment(xAttachment) = False Then

xTmpFile = xTmpPath & xAttachment.FileName

xAttachment.SaveAsFile xTmpFile

xTargetItem.Attachments.Add xTmpFile, , , xAttachment.DisplayName

xFSO.DeleteFile xTmpFile

End If

Next

If xFSO.FolderExists(xTmpPath) Then

Kill xTmpPath

End If

Set xFSO = Nothing

End Sub

Function IsEmbeddedAttachment(Attach As Attachment)

Dim xAttParent As Object

Dim xCID As String, xID As String

Dim xHTML As String

On Error Resume Next

Set xAttParent = Attach.Parent

xCID = ""

xCID = Attach.PropertyAccessor.GetProperty(http://schemas.microsoft.com/mapi/proptag/0x3712001F)

If xCID <> "" Then

xHTML = xAttParent.HTMLBody

xID = cid: & xCID

If InStr(xHTML, xID) > 0 Then

IsEmbeddedAttachment = True

Else

IsEmbeddedAttachment = False

End If

End If


End Function

2/ Go to tools and then References


3/ Click on Microsoft Scripting Runtine and then OK


Close the VBA.

4/ Click on More commands


5/ Go to Quick Access Toolbar and then on Macros


6/ Click on Project1.This…. and click on Add to put it on the right panel.


Then click on Modify to choose the Icon you want and then click on OK.