Question

我正在使用 Outlook 2010 ，我正在尝试编写一个宏，如果它与模式匹配，则用不同的文本替换文本字体。

我尝试应用的逻辑很简单 - 在用户选择的文本中，检查模式，并在匹配时更改匹配文本的字体。

到目前为止，我已经能够分割文本并应用/检查正则表达式，但替换是我不清楚如何做的事情。

Dim objOL As Application
Dim objDoc As Object
Dim objSel As Object
Dim regEx As RegExp
Dim matches As MatchCollection
Dim m As Match
Dim lines As Variant
Dim ms As String

Set objOL = Application
Set objDoc = objOL.ActiveInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection

lines = Split(objSel, Chr(13))
For i = 0 To UBound(lines) Step 1
  Set regEx = New RegExp
  With regEx
    .Pattern = "\[(ok|edit|error)\](\[.*\])?" ' <-- this is just one regex, I want to be able to check more regexes
    .Global = True
  End With
 If regEx.Test(lines(i)) Then
  Set matches = regEx.Execute(lines(i))
  For Each m In matches
     ms = m.SubMatches(1)
     ' ms.Font.Italic = True
     ' <-- here is where I am not sure how to replace! :( -->
  Next
End If    
Next i

PS似乎在objSel.Find.Text对象中有 text-search （objSel.Find.Replacement.Text）和替换（Selection）方法，但不是模式搜索！（或者我错过了它）

- 编辑 -

添加示例文本

user@host> show some data
..<few lines of data>..      <-- these lines as-is (but monospaced)
[ok][2014-11-26 11:05:02]
user@host> edit some other data
[edit data]
user@host(data)% some other command

我想将整个块转换为等宽字体（例如Courier New或Consolas）
并将以something@somewhere ..开头的部分更改为>或%以更暗色调，（即在此示例中为user@host>和user@host(data)%调光器/灰色）
该行中的其余部分为粗体（显示一些数据等）
并且，所有括号内的文字后跟时间戳（或没有时间戳），类似于2.（即暗淡/灰色）

Answer 1

这正在接近完成。该框架现在可以进行各种更改。只需要将一些正则表达式模式下来进行更改。

Sub FormatSelection()
    Dim objMailItem As Outlook.MailItem
    Dim objInspector As Outlook.Inspector: Set objInspector = Application.ActiveInspector
    Dim objHtmlEditor As Object
    Dim objWord As Object
    Dim Range As Word.Selection
    Dim objSavedSelection As Word.Selection
    Dim objFoundText As Object

    ' Verify a mail object is in focus.
    If objInspector.CurrentItem.Class = olMail Then

        ' Get the mail object.
        Set objMailItem = objInspector.CurrentItem

        If objInspector.EditorType = olEditorWord Then
            ' We are using a Word editor. Get the selected text.
            Set objHtmlEditor = objMailItem.GetInspector.WordEditor
            Set objWord = objHtmlEditor.Application
            Set Range = objWord.Selection
            Debug.Print Range.Range


            ' Set defaults for the selection
            With Range.Font
                .Name = "Courier"
                .ColorIndex = wdAuto
            End With

            ' Stylize the bracketed text
            Call FormatTextWithRegex(Range, 2, "\[(.+?)\]")

            ' Prompt style text.
            Call FormatTextWithRegex(Range, 2, "(\w+?@.+?)(?=[\>\%])")

            ' Text following the prompt.
            Call FormatTextWithRegex(Range, 3, "(\w+?@.+?[\>\%])(.+)")


        End If

    End If

    Set objInspector = Nothing
    Set Range = Nothing
    Set objHtmlEditor = Nothing
    Set objMailItem = Nothing
End Sub

Private Sub FormatTextWithRegex(ByRef pRange As Word.Selection, pActionIndex As Integer, pPattern As String)
    ' This routine will perform a regex replacement on the text in pRange using pPattern
    ' on text based on the pactionindex passed.
    Const intLightColourIndex = 15

    Dim objRegex As RegExp: Set objRegex = New RegExp
    Dim objSingleMatch As Object
    Dim objMatches As Object

    ' Configure Regex object.
    With objRegex
        .IgnoreCase = True
        .MultiLine = False
        .Pattern = pPattern ' Example "\[(ok|edit|error)\](\[.+?\])?"
        .Global = True
    End With

    ' Locate all matches if any.
    Set objMatches = objRegex.Execute(pRange.Text)

    ' Find
    If (objMatches.Count > 0) Then
        Debug.Print objMatches.Count & " Match(es) Found"
        For Each objSingleMatch In objMatches
            ' Locate the text associated to this match in the selection so we can replace it.
            Debug.Print "Match Found: '" & objSingleMatch & "'"
            With pRange.Find
                '.ClearFormatting
                .Text = objSingleMatch.Value
                .ClearFormatting
                Select Case pActionIndex
                    Case 1  ' Italisize text
                        .Replacement.Text = objSingleMatch.Value
                        .Replacement.Font.Bold = False
                        .Replacement.Font.Italic = True
                        .Replacement.Font.ColorIndex = wdAuto
                        .Execute Replace:=wdReplaceAll
                    Case 2  ' Dim the colour
                        .Replacement.Text = objSingleMatch.Value
                        .Replacement.Font.Bold = False
                        .Replacement.Font.Italic = False
                        .Replacement.Font.ColorIndex = intLightColourIndex
                        .Execute Replace:=wdReplaceAll
                    Case 3  ' Bold that text!
                        .Replacement.Text = objSingleMatch.Value
                        .Replacement.Font.Bold = True
                        .Replacement.Font.Italic = False
                        .Replacement.Font.ColorIndex = wdAuto
                        .Execute Replace:=wdReplaceAll
                End Select
            End With
        Next
    Else
        Debug.Print "No matches found for pattern: " & pPattern
    End If

    Set objRegex = Nothing
    Set objSingleMatch = Nothing
    Set objMatches = Nothing
End Sub

因此我们采用用户选择的内容并执行宏。我的Outlook为编辑器配置了Word，以便进行测试。获取所选文本并针对保存匹配项的文本运行正则表达式查询。

你遇到的问题是你找到它后该如何处理。在我的情况下，因为我们有匹配的实际文本，我们可以通过查找再次使用选择来替换。用自己替换文本而不是按指示设置。

<强>注意事项

我的测试文字如下：

asdfadsfadsf [ok] [测试] dsfadsfasdf asdfadsfadsfasdfasdfadsfadsf [ok] [测试] dsfadsfasdf asdfadsfadsfasdf

我必须更改样本中的正则表达式，因为它匹配两个[ok][Test]部分，因此不那么贪心。我不知道你正在使用什么样的文本，所以我的逻辑可能不适用于你的情况。谨慎测试。

您还有一个评论，您需要测试多个正则表达式...正则表达式....我不知道复数是什么。难以创建另一个为多个模式调用此函数的函数。假设这个逻辑重复它应该不是什么大问题。我想让这项工作对你有用，如果出现问题，请告诉我。

代码更新

我更改了代码，以便正则表达式替换为sub。那么代码现在所做的就是将所选文本更改为courier，并根据正则表达式将文本更改为italisize。现在，通过它的设置方式，您可以使用子例程FormatTextWithRegex进行更改。只需要更新将执行不同样式的模式和动作索引。有关更多信息，将很快再次更新。现在所有存在的东西都是我认为你需要的结构。

仍然存在粗体问题，但您可以看到灰色部分正常工作。此外，由于这依赖于突出显示对函数的多次调用导致问题。只是不确定它是什么。

用不同的字体替换匹配的图案

1 个答案: