我正在尝试使用该WordEditor
对象来修改所选文本(Outlook VBA)的颜色,但我无法找到有关如何执行此操作的文档或示例。有任何想法吗?
我不想使用 HTML 编辑器,我需要WordEditor
.
我尝试调试代码并使用 OutlookSpy,但每次我进入 WordEditor.Content 我的 Outlook 冻结并重新启动:(。
在 Windows 7 上使用 Outlook 2010
我正在尝试使用该WordEditor
对象来修改所选文本(Outlook VBA)的颜色,但我无法找到有关如何执行此操作的文档或示例。有任何想法吗?
我不想使用 HTML 编辑器,我需要WordEditor
.
我尝试调试代码并使用 OutlookSpy,但每次我进入 WordEditor.Content 我的 Outlook 冻结并重新启动:(。
在 Windows 7 上使用 Outlook 2010
好的 - 我发现了一些有用的东西。丑陋,但有效:
Sub EmphesizeSelectedText(color As Long)
Dim msg As Outlook.MailItem
Dim insp As Outlook.Inspector
Set insp = Application.ActiveInspector
If insp.CurrentItem.Class = olMail Then
Set msg = insp.CurrentItem
If insp.EditorType = olEditorWord Then
Set document = msg.GetInspector.WordEditor
Set rng = document.Application.Selection
With rng.font
.Bold = True
.color = color
End With
End If
End If
Set insp = Nothing
Set rng = Nothing
Set hed = Nothing
Set msg = Nothing
End Sub
最终我找到了WordEditor返回一个Document
对象的引用。从那里开始,我花了 2 小时浏览 MSDN 非常慢的网络帮助,发现要获得选定的文本,我需要上一级到Application
. 重要提示 - 更改rng.Style.Font
没有做我想做的事,它改变了整个文档,当我开始使用时,with rng.font
我的问题得到了解决(感谢 Excel 的 marco 记录能力向我展示了正确的语法)
注释是德语
Option Explicit
'Sub EmphesizeSelectedText(color As Long)
Sub EmphesizeSelectedText()
Dim om_msg As Outlook.MailItem
Dim oi_insp As Outlook.Inspector
Dim ws_selec As Word.Selection
Dim wd_Document As Word.Document
Dim str_test As String
Dim lng_color As Long
lng_color = 255
'Zugriff auf aktive E-Mail
Set oi_insp = Application.ActiveInspector()
'Überprüft ob es sich wirklich um eine E-Mail handelt
If oi_insp.CurrentItem.Class = olMail Then
Set om_msg = oi_insp.CurrentItem
If oi_insp.EditorType = olEditorWord Then
' es gibt noch "olEditorHTML", "olEditorRTF", "olEditorText" und "olEditorWord"
' ist bei mir aber immer "olEditorWord" (= 4) - egal was ich im E-Mail Editor auswähle
' Set wd_Document = om_msg.Getinspector.WordEditor ' macht das gleiche wie nächste Zeile
Set wd_Document = oi_insp.WordEditor
Set ws_selec = wd_Document.Application.Selection
str_test = ws_selec.Text
Debug.Print ws_selec.Text
ws_selec.Text = "foo bar"
If om_msg.BodyFormat <> olFormatPlain Then
' auch wenn om_msg.BodyFormat = olFormatPlain ist, kann oi_insp.EditorType = olEditorWord sein
' doch dann gehen Formatierungen nicht -> Error !!!
With ws_selec.Font
.Bold = True
.color = lng_color ' = 255 = red
.color = wdColorBlue
End With
End If
ws_selec.Text = str_test
End If
End If
Set oi_insp = Nothing
Set ws_selec = Nothing
Set om_msg = Nothing
Set wd_Document = Nothing
End Sub
Verweise:(不知道英文版是怎么称呼的)
格鲁兹 $3v|\|
另一个例子:
Option Explicit
Private Sub Test_It()
Dim om_Item As Outlook.MailItem
Dim oi_Inspector As Outlook.Inspector
Dim wd_Doc As Word.Document
Dim wd_Selection As Word.Selection
Dim wr_Range As Word.Range
Dim b_return As Boolean
Dim str_Text As String
str_Text = "Hello World"
'Zugriff auf aktive E-Mail
Set oi_Inspector = Application.ActiveInspector()
Set om_Item = oi_Inspector.CurrentItem
Set wd_Doc = oi_Inspector.WordEditor
'Zugriff auf Textmarkierung in E-Mail
Set wd_Selection = wd_Doc.Application.Selection
wd_Selection.InsertBefore str_Text
'Zugriff auf 'virtuelle' Markierung
'wr_Range muss auf das ganze Dokument gesetzt werden !
Set wr_Range = wd_Doc.Content
'Suche in E-Mail Text
With wr_Range.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindStop
.MatchWildcards = True
.Text = "#%*%#"
End With
b_return = True
Do While b_return
b_return = wr_Range.Find.Execute
If b_return Then
' Es wurde gefunden
str_Text = wr_Range.Text
'schneide den Anfangstext und das Ende ab
'str_TextID = Mid$(str_TextID, 11, Len(str_TextID) - 12)
MsgBox ("Es wurde noch folgender Schlüssel gefunden:" & vbCrLf & str_Text)
End If
Loop
'aktiv Range ändern
'wr_Range muss auf das ganze Dokument gesetzt werden !
Set wr_Range = wd_Doc.Content
wr_Range.Start = wr_Range.Start + 20
wr_Range.End = wr_Range.End - 20
'Text formatieren
With wr_Range.Font
.ColorIndex = wdBlue
.Bold = True
.Italic = True
.Underline = wdUnderlineDotDashHeavy
End With
'Freigeben der verwendeten Variablen
Set oi_Inspector = Nothing
Set om_Item = Nothing
Set wd_Doc = Nothing
Set wd_Selection = Nothing
Set wr_Range = Nothing
End Sub
格鲁兹 $3v|\|