使用 VBA 以编程方式更改 Outlook 中电子邮件正文的属性
Programmatically change properties in email body in Outlook with VBA
我有一封电子邮件准备在 Outlook 2013 中发送
我想扫描电子邮件正文中的粗体文本(即粗体字符)并将其颜色更改为红色
(很高兴)从宏中排除签名
我整理了下面的代码,但仍然无法正常工作。有什么想法吗?
Public Sub FormatSelectedText()
Dim objItem As Object
Dim objInsp As Outlook.Inspector
' Add reference to Word library
' in VBA Editor, Tools, References
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
On Error Resume Next
'Reference the current Outlook item
Set objItem = Application.ActiveInspector.CurrentItem
If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
Set objChar = Characters.Selection
' replace the With block with your code
With objChar
' Formatting code goes here
'.Font.Size = 18
If .Font.Bold = True Then
.Font.Color = wdColorBlue
End If
.Font.Color = wdColorRed
'.Font.Italic = True
'.Font.Name = "Arial"
End With
For Each Char In Characters.Selection
If Char.Font.Bold Then
Char.Font.Color = RGB(0, 0, 255) 'TextRGBTmp
End If
Next Char
For Each Char In Characters.Selection
If Not Char.Font.Bold And Char.Font.Color = RGB(0, 0, 255) Then
Char.Font.Color = RGB(0, 0, 0)
End If
Next Char
End If
End If
End If
Set objItem = Nothing
Set objWord = Nothing
Set objSel = Nothing
Set objInsp = Nothing
End Sub
这是问题的跟进:Programmatically change font properties in email body
首先:尝试调试代码时不要使用 On Error Resume Next
。它让你的生活更加艰难。
第二个:在模块的开头使用Option Explicit
。启用该选项后,VBA 将向您显示每个未初始化的变量(一些错误仅由拼写错误引起)。
我已经更正了你的代码,所以它适用于我:
Public Sub FormatSelectedText()
Dim objOutlook As Outlook.Application ' i used this because im working in MS Access
Dim objItem As Object
Dim objInsp As Outlook.Inspector
' Add reference to Word library
' in VBA Editor, Tools, References
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
Dim objChar As Object
Dim Char As Object
'Reference the current Outlook item
Set objOutlook = GetObject(, "Outlook.Application")
Set objItem = objOutlook.ActiveInspector.CurrentItem
If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
Set objChar = objSel.Characters ' this wasn't initialized
' replace the With block with your code
' With objChar ' you don't Need this block because objChar is an array and it throws an error when you try to use this code on the whole objChar object
' ' Formatting code goes here
' '.Font.Size = 18
' If .Font.Bold = True Then
' .Font.color = wdColorBlue
' End If
' .Font.color = wdColorRed
' '.Font.Italic = True
' '.Font.Name = "Arial"
' End With
For Each Char In objSel.Characters
If Char.Font.Bold Then
Char.Font.color = rgb(255, 0, 0) 'TextRGBTmp (the rgb was filled backwards, so the text became blue. i fixed it.
End If
Next Char
' the code of the second For Each was not neccessary.
End If
End If
End If
Set objItem = Nothing
Set objWord = Nothing
Set objSel = Nothing
Set objInsp = Nothing
End Sub
我有一封电子邮件准备在 Outlook 2013 中发送 我想扫描电子邮件正文中的粗体文本(即粗体字符)并将其颜色更改为红色 (很高兴)从宏中排除签名
我整理了下面的代码,但仍然无法正常工作。有什么想法吗?
Public Sub FormatSelectedText()
Dim objItem As Object
Dim objInsp As Outlook.Inspector
' Add reference to Word library
' in VBA Editor, Tools, References
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
On Error Resume Next
'Reference the current Outlook item
Set objItem = Application.ActiveInspector.CurrentItem
If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
Set objChar = Characters.Selection
' replace the With block with your code
With objChar
' Formatting code goes here
'.Font.Size = 18
If .Font.Bold = True Then
.Font.Color = wdColorBlue
End If
.Font.Color = wdColorRed
'.Font.Italic = True
'.Font.Name = "Arial"
End With
For Each Char In Characters.Selection
If Char.Font.Bold Then
Char.Font.Color = RGB(0, 0, 255) 'TextRGBTmp
End If
Next Char
For Each Char In Characters.Selection
If Not Char.Font.Bold And Char.Font.Color = RGB(0, 0, 255) Then
Char.Font.Color = RGB(0, 0, 0)
End If
Next Char
End If
End If
End If
Set objItem = Nothing
Set objWord = Nothing
Set objSel = Nothing
Set objInsp = Nothing
End Sub
这是问题的跟进:Programmatically change font properties in email body
首先:尝试调试代码时不要使用 On Error Resume Next
。它让你的生活更加艰难。
第二个:在模块的开头使用Option Explicit
。启用该选项后,VBA 将向您显示每个未初始化的变量(一些错误仅由拼写错误引起)。
我已经更正了你的代码,所以它适用于我:
Public Sub FormatSelectedText()
Dim objOutlook As Outlook.Application ' i used this because im working in MS Access
Dim objItem As Object
Dim objInsp As Outlook.Inspector
' Add reference to Word library
' in VBA Editor, Tools, References
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
Dim objChar As Object
Dim Char As Object
'Reference the current Outlook item
Set objOutlook = GetObject(, "Outlook.Application")
Set objItem = objOutlook.ActiveInspector.CurrentItem
If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
Set objChar = objSel.Characters ' this wasn't initialized
' replace the With block with your code
' With objChar ' you don't Need this block because objChar is an array and it throws an error when you try to use this code on the whole objChar object
' ' Formatting code goes here
' '.Font.Size = 18
' If .Font.Bold = True Then
' .Font.color = wdColorBlue
' End If
' .Font.color = wdColorRed
' '.Font.Italic = True
' '.Font.Name = "Arial"
' End With
For Each Char In objSel.Characters
If Char.Font.Bold Then
Char.Font.color = rgb(255, 0, 0) 'TextRGBTmp (the rgb was filled backwards, so the text became blue. i fixed it.
End If
Next Char
' the code of the second For Each was not neccessary.
End If
End If
End If
Set objItem = Nothing
Set objWord = Nothing
Set objSel = Nothing
Set objInsp = Nothing
End Sub