Question

我正在编写一个脚本，该脚本可以查看我发送的电子邮件并搜索我经常犯的样式错误。它使用正则表达式找到它们，然后将其突出显示为黄色。代码：

Public Sub highlightBadForm()

    Dim oWordDoc As Object
    Dim oMatches As Object
    Dim oRange As Range
    Dim strText As String
    Dim lngFindFrom As Long
    Dim varMtch As Variant

    Set oWordDoc = Application.ActiveInspector.WordEditor
    strText = LCase(oWordDoc.Range.Text)

    lngFindFrom = InStr(strText, "from: ")
    If lngFindFrom > 0 Then
        strText = Left(strText, lngFindFrom - 1)
    End If

    Set oMatches = extractMatches(strText, getBadStrs)
    If Not oMatches Is Nothing Then
        For Each varMtch In oMatches
                Set oRange = oWordDoc.Range(varMtch.firstindex, varMtch.firstindex + varMtch.Length)
                oRange.HighlightColorIndex = wdYellow
        Next varMtch
    End If

    Set oRange = Nothing
    Set oWordDoc = Nothing
    Set oMatches = Nothing
End Sub

extractMatches是实现VBA的RegEx引擎的私有函数。 getBadStrs返回包含错误的正则表达式。

除非我在电子邮件中嵌入了超链接，否则所有操作均有效。如果是这样，oWordDoc.Range.Text仅返回链接的锚文本，而不返回链接（以及任何其他用Word填充超链接的字符-我不知道它们可能是什么）。结果，varMtch.firstindex对strText是正确的，但对oRange不是正确的，因此突出显示的文本偏移了几个字符。

我尝试通过遍历oRange中的超链接并假定链接文本包含在oRange中来将完整的oRange文本循环到字符串中。像这样：

Dim lngEndLnk as Long
Set oRange = oWordDoc.Range

For Each varMtch In oRange.Hyperlinks
    strText = strText & oWordDoc.Range(lngEndLnk, varMtch.Range.Start)
    strText = strText & varMtch.TextToDisplay & varMtch.Name
    lngEndLnk = varMtch.Range.End
Next varMtch

If lngEndLnk = 0 Then
    strText = oRange.text
Else
    strText = strText & oWordDoc.Range(lngEndLnk, oWordDoc.Range.End)
End If

这减少了偏移量，但是仍然有一个。另外，如果我要在电子邮件中包含链接的图像，则.Anchor的{{1}}属性将失败，因此我不得不提出另一种解决方法。

是否有更简单的方法来获取包含varMtch对象的所有字符的String，以便使正则表达式索引对齐？

Answer 1

您可以使用hyperlinks文档集合来访问超链接地址：

Private Sub CommandButton1_Click()
    strtext = ActiveDocument.Range.Text
    MsgBox (strtext)
    For Each hLink In Documents(1).Hyperlinks
     MsgBox (hLink.Address)
    Next hLink
End Sub

这首先显示文档中的所有文本，然后遍历显示其URL的每个超链接。

然后可以通过RegEx使用它。

有关更多信息和示例，请参见hyperlinks。

Answer 2

此操作的关键似乎是当您遍历Range时，查看范围内的每个“位置”，例如通过类似

With ActiveDocument.Range
  For i = 0 to .End - 1
    Debug.Print i,Ascw(.Range(i,i+1).Text)
  Next
End With

Range确实包含诸如HYPERLINK字段之类的字段代码中的所有字符，以及其结果中的所有字符（可能会显示，也可能是隐藏的文本）。但在某些情况下，范围可能包含从未显示的其他字符。例如，如果您有一个字段代码，例如{SET x 123}，那么Range包含有效的字段括号和代码“ SET X 123”，但是在字段结尾括号之前，它还包含一个标记，后跟一个值“ 123”。但是SET字段不显示其结果。

这使得构造与范围相同长度的“查找”字符串变得困难。

但是 Range.Text是与Range.Characters中所有字符的并置相同的文本，并且该Collection中的每个Character是一个包含.Start位置的Range。

这样我们就可以获取.Start和.End，如下面的示例所示。

这假定您正在Word中使用ActiveDocument，并具有一些文本，一个HYPERLINK字段（例如），并可能还有其他字段，这些文本在各个位置都有“ test1”。

我没有做太多测试，因此可能仍需要调整。

Sub HighlightFinds()
Dim match As VBScript_RegExp_55.match
Dim matches As VBScript_RegExp_55.MatchCollection
Dim rng1 As Word.Range
Dim rng2 As Word.Range
Set rng1 = ActiveDocument.Content
Set rng2 = ActiveDocument.Content ' or rng1.Duplicate

' When you do this, rng1.Text returns the text of the field *codes* but
' not the field *results*, and so does rng1.Characters
'rng1.TextRetrievalMode.IncludeFieldCodes = True
' when you do this, it returns the *results* but not the *codes*
rng1.TextRetrievalMode.IncludeFieldCodes = False

' You could do both, one after the other, to try to get all the matches

' You might also need to set .TextRetrievalMode.IncludeHiddenText

With New VBScript_RegExp_55.RegExp
  .Pattern = "test1"
  .Global = True
  Set matches = .Execute(rng1.Text)
End With
For Each match In matches
  rng2.SetRange rng1.Characters(match.FirstIndex + 1).Start, rng1.Characters(match.FirstIndex + 1 + match.Length).End
  rng2.HighlightColorIndex = wdYellow
Next
Set matches = Nothing
Set rng2 = Nothing
Set rng1 = Nothing
End Sub

Answer 3

最后我得到了与@sallyly snarky类似的解决方案。我不知道这会更好，所以我不会将其标记为解决方案。万一有一个明显的赢家我没看到，很高兴就利弊发表评论。

我个人而言，我喜欢循环字符集合，可能应该在我的代码中使用它，这可以工作。我发现使用位置数组来突出显示匹配项比从范围中构造字符串要直观得多。就我的目的而言，用#填充字符串来代替oWordDoc.Range中的零长度字符是可行的，但是我也知道它并不适合所有人。

Public Sub highlightBadForm()

    Dim oWordDoc As Object
    Dim oMatches As Object
    Dim oRange As Range
    Dim strText As String
    Dim lngFindFrom As Long, lngC As Long, lngPrevLen As Long
    Dim varMtch As Variant

    Set oWordDoc = Application.ActiveInspector.WordEditor

    For lngC = 0 To oWordDoc.Range.End - 1
        strText = strText & oWordDoc.Range(lngC, lngC + 1)
        If Len(strText) = lngPrevLen Then
            strText = strText & "#"
        End If
        lngPrevLen = lngPrevLen + 1
    Next lngC
    strText = LCase(strText)

    lngFindFrom = InStr(strText, "from: ")
    If lngFindFrom > 0 Then
        strText = Left(strText, lngFindFrom - 1)
    End If

    Set oMatches = extractMatches(strText, getBadStrs)
    If Not oMatches Is Nothing Then
        For Each varMtch In oMatches
                Set oRange = oWordDoc.Range(varMtch.FirstIndex, varMtch.FirstIndex + varMtch.Length)
                oRange.HighlightColorIndex = wdYellow
        Next varMtch
    End If

    Set oRange = Nothing
    Set oWordDoc = Nothing
    Set oMatches = Nothing
End Sub

获取全范围文本到字符串

3 个答案: