Outlookで元の添付ファイルを含めて全員に返信するにはどうすればよいですか？

Author: Xiaoyang Last Modified: 2025-05-23

Outlookで「全員に返信」を押して、元の添付ファイルが消えてしまったことはありませんか？それはイライラしますよね！全員に返信する際にその添付ファイルを保持する方法が気になりますか？はい、可能です！では、どのように元の添付ファイルを返信に含めるか見ていきましょう。これにより、メール管理がスムーズかつ効率的になります。お楽しみに！

VBAコードを使用して全員に元の添付ファイル付きで返信する

Kutools for Outlookを使用して全員に元の添付ファイル付きで返信する

VBAコードを使用して全員に元の添付ファイル付きで返信する

このタスクを直接処理する機能はOutlookにはありませんが、以下のVBAコードを適用することで実現できます。以下の手順で行ってください：

1. Outlookを起動し、ALT + F11キーを押してMicrosoft Visual Basic for Applicationsウィンドウを開きます。

2. Microsoft Visual Basic for Applicationsウィンドウで、Project1(VbaProject.OTM)ペインから ThisOutlookSessionをダブルクリックしてモードを開き、次のコードを空白のモジュールにコピーして貼り付けます。

VBAコード: 元の添付ファイルを含めて全員に返信する：

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

3. 次に、Microsoft Visual Basic for Applicationsウィンドウで Tools > Referencesをクリックし、表示されたReferences-Project1ダイアログボックスでAvailable ReferencesリストボックスからMicrosoft Scripting Runtimeオプションをチェックしてください。スクリーンショットをご覧ください：