May times it happens that you want to Reply some mail with attachment but when you click reply, it removes the attachment from your mail, and you need to attach it manually. Following function will help you to reply mail with attachment.
'''''''''''''''''''''' Reply Module ''''''''''''''''''''''''''
Sub ReplyWithAttachments() ' For Only single Reply
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
Sub ReplyALLWithAttachments() ' For Reply ALL
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
Sub ReplyOnly() ' For Only Reply without Body message
Dim rpl As Outlook.MailItem
Dim itm As Object
Set itm = GetCurrentItem()
If Not itm Is Nothing Then
Set rpl = itm.Reply
rpl.subject = itm.subject
rpl.Display
' rpl.HTMLBody = rpl.HTMLBody
SendKeys "^f"
SendKeys "From:"
SendKeys "{Enter}"
SendKeys "{Esc}"
SendKeys "{Home}"
SendKeys "^+{End}"
SendKeys "{Del}"
SendKeys "^{Home}"
End If
Set rpl = Nothing
Set itm = Nothing
End Sub
Function GetCurrentItem() As Object ' Will Create object for the current selected One mail
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) ' Coping the Attachment if exist.
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
'''''''''''''''''''''' End of Reply Module '''''''''''''''''''''''''''''''''''''''''''
No comments:
Post a Comment
Your feedback is always appreciated. I will try to reply to your queries as soon as time allows.Please don't spam,spam comments will be deleted upon reviews.