Why can't I replace attachments to original location in RTF?

  • Article

If you ever tried to manipulate attachments within RTF emails then you are probably aware of this weird issue. Say you have 4 attachments in the email body of a RTF email. Now if you programmatically tries to delete those attachments and place new attachments to their original location then you will see how messy it could be.

The attachments loose their position and can be placed anywhere in the body. So whom to blame? The code.. really? Not exactly but yes to code. This is a weird timing issue and we still do not know the real root cause of the problem. But the below code can do the job for you.

 

 Sub AttachmentRTF() Dim oItem As Object Dim oAttachments As Outlook.Attachments Dim iCount As Integer Dim arrPos() Dim arrPath() Dim sAttPathFileName Dim sAttFileName Dim i As Integer Const sAttPath = "C:\" Set oItem = Application.ActiveInspector.CurrentItem Set oAttachments = oItem.Attachments iCount = oAttachments.Count If iCount > 0 Then     ReDim arrPos(iCount)     ReDim arrPath(iCount)     ' Remove all attachments     For i = iCount To 1 Step -1         arrPos(i) = oAttachments(i).Position         arrPath(i) = sAttPath & "Restored_" & oAttachments.Item(i).FileName         oAttachments.Item(i).SaveAsFile arrPath(i)         oAttachments(i).Delete         oItem.Save     Next     ' Add back attachments in original positions     For i = 1 To iCount         oItem.Attachments.Add arrPath(i), , arrPos(i)         oItem.Save     Next End If End Sub

Please do let me know if you face any problems with this code.

References:

Attachments Object

https://msdn2.microsoft.com/en-us/library/bb147604.aspx

"To ensure consistent results, always save an item before adding or removing objects in the Attachments collection of the item."