环境
Office 2013 对应 Office\15.0
Office 2016 对应 Office\16.0
以下为 Office 2013 配置方式，其他版本注意更变 Office\15.0。
Outlook 设置下载文件默认保存位置
- 注册表：HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Outlook\Options
- 新增 DefaultPath 字符串值：文件夹完整路径
Outlook 解除附件大小 20M 限制
2048000 = 2G，建议内网环境使用。通常外网邮箱不接收超过 50M 的邮件。部分不接收超过 10M 的邮件。请酌情修改。
- REG ADD HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Outlook\Preferences\ /v "MaximumAttachmentSize" /t REG_DWORD /d 2048000 /f
- REG ADD HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Outlook\Profiles\Outlook\Preferences\ /v "MaximumAttachmentSize" /t REG_DWORD /d 2048000 /f
VBA Outlook 带附件回复
Sub 带附件回复()
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