這個代碼是網上的為了實作outlook 2010回復 的時候自動帶上附件,但是這個代碼把郵件正文中的圖片,也自動帶到附件里面了!
現在請大神幫忙修改下代碼回復郵件的時候只帶上一封附件中附件,不把正文的圖片也作為附件自動帶到附件中,謝謝!
代碼如下:
Sub ReplyWithAttachments()
Dim rpl As Outlook.MailItem
Dim itm As Object
Set itm = GetCurrentItem()
If Not itm Is Nothing Then
Set rpl = itm.Reply
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
Sub ReplyToAllWithAttachments()
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
轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/65435.html
標籤:VB基礎類
上一篇:如何截取字串
