Однако команда удаления срабатывает не так, как ожидается - картинка удаляется, но вместо неё появляется крестик (который используется обычно когда объект не найден на web-странице).
Есть и другая проблема - новая картинка вставляется не на место старой (не в текст), а прикрепляется к письму отдельно.
Как эти две проблемы побороть?
- Код: Выделить всё
Sub ChangePictures()
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFSO = CreateObject("Scripting.FileSystemObject")
' getting current e-mail object opened
Set objMessage = Application.ActiveInspector.CurrentItem
If TypeName(objMessage) = "MailItem" Then
intCount = objMessage.Attachments.Count
If intCount > 0 Then
For i = intCount To 1 Step -1 ' go from last file to the first one
If objMessage.Attachments.Item(i).Type = 1 Then
sFileName = objMessage.Attachments.Item(i).FileName
If (Right(sFileName, 3) <> "bmp") Then ' look for bmp files only
Dim iPos
iPos = objMessage.Attachments.Item(i).Position
' some changes of the picture are performed here
' ...
objMessage.Attachments.Add "newpicture.bmp", _
olByValue, iPos
objMessage.Attachments.Item(i).Delete ' delete attachment
End If
End If
Next
End If
End If
End Sub
