Outlook VBA用文本替换内联对象 [英] Outlook VBA Replace inline object with text
问题描述
我的收件箱中有一封电子邮件,其中包含一个内联对象(例如图像).我要删除它,然后在电子邮件中的同一位置插入文本.
I have an email message in my Inbox which contains an inline object (e.g., an image). I want to remove it, and insert text at the same point in the email.
我尝试了两种方法:
-
使用
Dim objAttachment As Outlook.Attachment
处理对象.我尝试使用Position
方法,但是问题是,无论对象的位置如何(无论它是内联的还是在附件栏"中),它总是返回0
..
Dealing with objects with
Dim objAttachment As Outlook.Attachment
. I tried using thePosition
method, but the problem is that it always returns0
, regardless of the position of the object (and whether it is inline or in the "attachments bar").
使用Dim shp As Word.InlineShape
处理对象.我可以用Set shpRange = objDoc.Range(shp.Range.Characters.First.Start, shp.Range.Characters.Last.End)
(和Dim objDoc As Word.Document
确定shp
的位置;感谢下面的答案) .我尝试通过三种方式修改objDoc
.
Dealing with objects with Dim shp As Word.InlineShape
. I could determine the location of shp
, with Set shpRange = objDoc.Range(shp.Range.Characters.First.Start, shp.Range.Characters.Last.End)
(and Dim objDoc As Word.Document
; thanks to an answer below). I tried modifying objDoc
in three ways.
2.1. shpRange.InsertAfter "Replacement Text 1"
.
2.2. shpRange.Text = "Replacement Text 2"
.
2.3. objDoc.Characters(1).InsertBefore "New Text"
.
问题是它们都没有修改电子邮件.
到目前为止,我对objMsg.HTMLBody = <mytext> + objMsg.HTMLBody
使用了方法1,然后对objMsg.Save
使用了方法1.但这会在开头添加文本.
So far, I have used method 1 with objMsg.HTMLBody = <mytext> + objMsg.HTMLBody
, then objMsg.Save
. But this adds text at the beginning.
PS:当有人回复带有嵌入式对象的电子邮件时,有时会将其替换为对象所在位置的文本(我不确定何时完成).也许MS没有提供完成此功能的功能.
PS: when one replies to an email with an inline object, it is sometimes replaced with text at the location of the object (I could not ascertain when this is done). Perhaps MS does not provide functionality for accomplishing the same.
编辑(其他详细信息,最初不包括以避免tl; dr)
注意:
The code I am currently using is based on a post by Nicola Delfino. It uses
objMsg.HTMLBody
, see below. On the up side, it finds most inline attachments/objects (some are missed), and all in the "attachments bar" (I do not know the official name for it). On the down side, it cannot discriminate inline from "bar-attached" items, and it cannot get the location of inline objects found. So I had it add text only at the beginning of the mail body.
我看到我尝试发送的任何电子邮件的问题.例如,我创建了一封电子邮件,并使用Insert -> Picture
插入了图片.发送电子邮件后,我在Sent Items
文件夹中处理了电子邮件.
I see the problem with any email I tried. For instance, I have created an email, and inserted a picture with Insert -> Picture
. After sending the email, I worked with the email in my Sent Items
folder.
我将附加用于测试的示例电子邮件的图像.
I am attaching an image of a sample email that I used for testing.
It might be the case that objMsg.HTMLBody
could never work, and that I should go with WordEditor
, after reading this official page for Outlook 2007:
"17.5 Using WordEditor
The Outlook object model itself provides no direct way to determine the position of the cursor in an item body. However, since the editor for every item body (except on "sticky notes" and distribution lists) is a special version of Microsoft Word, you can use Word techniques not only to add text at the insertion point, but also to add formatted text anywhere in the item, or even to add a picture."
可能相关的链接:
Public Sub StripAttachments()
'Put in the folder location you want to save attachments to
Dim strFolder As String
strFolder = "removed_attachments"
Dim ilocation As String
ilocation = GetSpecialFolder(&H5) & "\" & strFolder ' CSIDL_MY_DOCUMENTS As Long = &H5"
On Error Resume Next
ilocation = ilocation & "\"
' Instantiate an Outlook Application object.
Dim objOL As Outlook.Application
Set objOL = Application
' Get the collection of selected objects.
Dim objSelection As Outlook.Selection
Set objSelection = objOL.ActiveExplorer.Selection
'Dim objMsg As Object
Dim objMsg As Outlook.MailItem
' Check each selected item for attachments. If attachments exist, save them to the selected
' folder and strip them from the item.
For Each objMsg In objSelection
' This code only strips attachments from mail items.
If (objMsg.Class = olMail) Then
Dim objInsp As Outlook.Inspector
Set objInsp = objMsg.GetInspector
Dim objDoc As Word.Document
Set objDoc = objInsp.WordEditor
' Get the Attachments collection of the item.
Dim objAttachments As Outlook.attachments
Set objAttachments = objMsg.attachments
Dim lngCount As Long
lngCount = objAttachments.Count
If lngCount > 0 Then
' We need to use a count down loop for removing items from a collection. Otherwise,
' the loop counter gets confused and only every other item is removed.
Dim strFile As String
strFile = ""
Dim I As Long
For I = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
Dim objAttachment As Outlook.Attachment
Set objAttachment = objAttachments.item(I)
Dim strHTML As String
strHTML = "<li><a href=" & Chr(34) & "file:" & ilocation & objAttachment.FileName & Chr(34) _
& ">" & objAttachment.FileName & "</a><br>" & vbCrLf
strFile = strFile & strHTML
Dim attPos As Long
attPos = objAttachment.Position
' Save the attachment as a file
objAttachment.SaveAsFile (ilocation & objAttachments.item(I))
' Remove the attachment
objAttachment.Delete
' Replace with text and hyperlink
'strFile = "Attachments removed from the message and backed up to [<a href='" & ilocation & "'>" & ilocation & "</a>]:<br><ul>" & strFile & "</ul><hr><br><br>" & vbCrLf & vbCrLf
Next I
strFile = "Attachments removed from the message and backed up to [<a href='" & ilocation & "'>" & ilocation & "</a>]:<br><ul>" & strFile & "</ul><hr><br><br>" & vbCrLf & vbCrLf
objDoc.Characters(1).InsertBefore strFile ' Does nothing!
objMsg.HTMLBody = strFile + objMsg.HTMLBody
objMsg.Save
Else
msgbox ("No attachments were found in the selected email")
End If
Else
msgbox ("Selection is not of type olMail")
End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
推荐答案
如果我没记错的话,WordEditor
基本上是一个词Document
,所以你应该可以做类似的事情(在Word中测试过,可能需要为Outlook进行调整),假设像doc
这样的对象变量代表Document
:
The WordEditor
basically is a word Document
if I remember correctly, so you should be able to do something similar to (tested in Word, may need tweak for Outlook), assuming an object variable like doc
to represent the Document
:
修订版&在Outlook 2010中进行了测试
Dim shp as InlineShape
Dim doc as Object `Word.Document
Dim shpRange as Object `Word.Range
Const wdInlineShapePicture as Long = 3
Const wdInlineShapesEmbeddedOLEObject as Long = 1
Set doc = objMsg.GetInspector.WordEditor
For Each shp In doc.InlineShapes
Select Case shp.Type
Case wdInlineShapePicture, wdInlineShapesEmbeddedOLEObject
'## Assign a range object with the text position of the shape
Set shpRange = doc.Range(shp.Range.Characters.First.Start, _
shp.Range.Characters.Last.End)
'## Replace the shape with text:
shpRange.Text = "Replacement Text"
Case Else
'## Do something else for other shape types, etc.
End Select
Next
这是一个示例宏,用于处理传入的邮件项目,并用文本替换嵌入的图像.请注意需要UnProtect
文档
Here is an example macro to process incoming mailitems, and replace the embedded images with text. Note the need to UnProtect
the document:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim arr() As String
Dim i As Integer
Dim m As MailItem
'## Word objects, using late-binding (or enable reference to MS Word)
Dim shp As Object 'Word.InlineShape
Dim doc As Object 'Word.Document
Dim shpRange As Object 'Word.Range
'## Establish some word constants for use with late-binding
Const wdInlineShapePicture As Long = 3
Const wdInlineShapeEmbeddedOLEObject As Long = 1
Const wdInlineShapeLinkedPicture As Long = 4
arr = Split(EntryIDCollection, ",")
For i = 0 To UBound(arr)
Set m = Application.Session.GetItemFromID(arr(i))
Set doc = m.GetInspector.WordEditor
doc.UnProtect
For Each shp In doc.InlineShapes
Select Case shp.Type
Case wdInlineShapePicture, _
wdInlineShapeEmbeddedOLEObject, _
wdInlineShapeLinkedPicture
'## Assign a range object with the text position of the shape
Set shpRange = doc.Range(shp.Range.Characters.First.Start, _
shp.Range.Characters.Last.End)
'## Replace the shape with text:
shpRange.Text = "Replacement Text"
Case Else
End Select
Next
Next
End Sub
这篇关于Outlook VBA用文本替换内联对象的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!