Why can't I replace attachments to original location in RTF? - Jive into Messaging world - Site Home

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