vba - 在 Outlook 上将脚本作为 Word 荧光笔运行
问题描述
目的是仅在满足特定规则时在 Outlook 上运行脚本,例如,当出现“the”一词时,将在该电子邮件上运行一个脚本,突出显示所有出现的“the”一词。一直在尝试代码,但不知道我哪里出错了。该代码似乎可以使用,但应用时指定的单词没有突出显示。规则标识一个特定的词,例如“the”,然后脚本将在标识的电子邮件中适用时突出显示该词。理想情况下,该脚本仅在规则识别此指定单词时激活。任何帮助都会很棒,谢谢。
Sub Highlight_AllOccurencesOfSpecificWords(MyMail As Outlook.MailItem)
Dim strWord As String
Dim strHTMLBody As String
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
strHTMLBody = objMail.HTMLBody
Set ns = Application.GetNamespace("MAPI")
'Change the word as per your wishes
strWord = "the"
If InStr(strHTMLBody, strWord) > 0 Then
strHTMLBody = Replace(strHTMLBody, strWord, "<font style=" & Chr(34) & "background-color: yellow" & Chr(34) & ">" & strWord & "</font>")
objMail.HTMLBody = strHTMLBody
End If
objMail.Save
End Sub
Updated Code:
Option Compare Text
Sub Highlight_AllOccurencesOfSpecificWords(MyMail As Outlook.MailItem)
Dim strWord As String
Dim strHTMLBody As String
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim myArray As Variant
Dim x As Long
strHTMLBody = MyMail.HTMLBody
Set ns = Application.GetNamespace("MAPI")
'Words can be added/removed below in the brackets after Array in (" "), words can be typed within quotation marks
myArray = Array("today", "tomorrow")
For x = LBound(myArray) To UBound(myArray)
If InStr(strHTMLBody, myArray(x)) > 0 Then
strHTMLBody = Replace(strHTMLBody, myArray(x), "<font style=" & Chr(34) & "background-color: turquoise" & Chr(34) & ">" & myArray(x) & "</font>")
MyMail.HTMLBody = strHTMLBody
End If
Next x
MyMail.Save
End Sub
解决方案
您的宏什么都不做,因为参数是MyMail
,但宏修改了objItem
.
删除Dim objItem As Outlook.MailItem
替换objItem
为MyMail
:
strHTMLBody = objMail.HTMLBody
objMail.HTMLBody = strHTMLBody
objMail.Save
Option Explicit
我假设您的模块顶部没有。这是一种很好的做法,因为它使这种类型的错误更难提交。我的代码出现编译时错误。
我认为“the”可以替代您要突出显示的真实单词。如果真正的词是模糊的,那么应该没有问题。但是,如果字符串“the”是 URL 或类似内容的一部分,则此代码会弄乱电子邮件。
我没有使用规则来测试您的代码。我选择了一封我很乐意破坏的旧电子邮件并运行了以下代码:
Sub TestHighlight()
Dim Exp As Explorer
Dim ItemCrnt As MailItem
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Call MsgBox("Please select one or more emails then try again", vbOKOnly)
Exit Sub
Else
For Each ItemCrnt In Exp.Selection
Call Highlight_AllOccurencesOfSpecificWords(ItemCrnt)
Next
End If
End Sub
我推荐使用这种技术来测试我几乎所有的 Outlook 宏。
推荐阅读
- list - 序言帮助 | 当它应该是假的时候,'tony'怎么会是真的呢?
- android - 将多个文件添加到 androidManfist.xml
- r - xts 中的错误 - “'order.by' 不能包含 'NA'、'NaN' 或 'Inf'”
- flutter - 如何通过从 Flutter 的底部表格中选择颜色来更新屏幕上的文本颜色?
- javascript - React 检查数组的元素是否有条件显示
- c - C SDL VS Code 图像未显示
- javascript - 数组值 JavaScript 发生意外变化
- azure - Azure AD 出现“身份验证失败,原因是:jwt 受众无效”
- java - 我想为错误的用户输入添加一个 try/catch 块
- regex - 编写一个正则表达式来识别大的或蓬松的狗和猫。(来自学习计划)