outlook全部回复自动添加附件
outlook吧
全部回复
仅看楼主
level 11
Outlook可否在回复邮件或者全部回复邮件的时候,能自动附上,之前发件人的邮件[E-MAIL SYMBOL],多谢!
2015年05月12日 06点05分 1
level 3
同问
2015年05月14日 02点05分 2
level 1
打开Outlook,ALT + F11,打开VBA窗口,帖上如下代码,保存。
自定义功能区,找到刚才添加的宏,放置到主页邮件功能区,再重命名即可。
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
2019年04月18日 02点04分 3
1