outlook带附件答复或带附件答复所有问题

niupin

网上找了个带附件答复和带附件答复所有的VBA代码，但是每次带附件答复时，除了带原邮件的附件外，还把正文里的图片给转成附件了，有没有办法解决？只带原邮件的附件，忽略正文贴的图片。
原邮件2个附件：


带附件答复后：

lx105834038

网上找的代码，不知道楼主的是不是以下这个。原理很简单，F8运行一下会发现正文中的图片都是以“imageXXX”的名称命名的如“image001”，那么只要把名称前缀是这个的剔除即可。
接下来就简单了，在copy里面增加一个if判断剔除不要的正文的图片剩下的就是我们要的附件啦。

1. '带附件回复
   
2. Sub ReplyWithAttachments()
   
3. Dim rpl As Outlook.MailItem
   
4. Dim itm As Object
   
5. Set itm = GetCurrentItem()
   
6. If Not itm Is Nothing Then
   
7. Set rpl = itm.Reply
   
8. CopyAttachments itm, rpl
   
9. rpl.Display
   
10. End If
    
11. Set rpl = Nothing
    
12. Set itm = Nothing
    
13. End Sub
    
14. '带附件回复所有
    
15. Sub ReplyToAllWithAttachments()
    
16. Dim rpl As Outlook.MailItem
    
17. Dim itm As Object
    
18. Set itm = GetCurrentItem()
    
19. If Not itm Is Nothing Then
    
20. Set rpl = itm.ReplyAll
    
21. CopyAttachments itm, rpl
    
22. rpl.Display
    
23. End If
    
24. Set rpl = Nothing
    
25. Set itm = Nothing
    
26. End Sub
    
27. '获取主题名称
    
28. Function GetCurrentItem() As Object
    
29. Dim objApp As Outlook.Application
    
30. Set objApp = Application
    
31. On Error Resume Next
    
32. Select Case TypeName(objApp.ActiveWindow)
    
33. Case "Explorer"
    
34. Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1) '获取主题名称
    
35. Case "Inspector"
    
36. Set GetCurrentItem = objApp.ActiveInspector.CurrentItem '获取主题名称
    
37. End Select
    
38. Set objApp = Nothing
    
39. End Function
    
40. '复制附件
    
41. Sub CopyAttachments(objSourceItem, objTargetItem)
    
42. Set fso = CreateObject("Scripting.FileSystemObject")
    
43. Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
    
44. strPath = fldTemp.Path & ""
    
45. For Each objAtt In objSourceItem.Attachments
    
46. <font color="#ff0000">If Left(objAtt, 5) = "image" Then
    
47. GoTo down</font>
    
48. <font color="#ff0000">Else</font>
    
49. strFile = strPath & objAtt.FileName
    
50. objAtt.SaveAsFile strFile
    
51. objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
    
52. fso.DeleteFile strFile
    
53. <font color="#ff0000">End If
    
54. down:</font>
    
55. Next
    
56. Set fldTemp = Nothing
    
57. Set fso = Nothing
    
58. End Sub

复制代码

pengminsen

outlook带附件答复的代码是怎么用的，求教 ，谢谢