Word VBAの文字列間のVBAの不一致

Question

regexを使用して、Wordの文書内のすべてのパターンマッチを検索します。

私が探しているファイルは〜330ページで、コピー/ペーストされたメールが含まれています。私の問題は、InStr(startPos, objRange.Text, match.submatches(0))を使用して各一致の開始位置を見つけると、結果は実際にはいくらかの量だけオフセットされるということです。元の状態の文書の場合、そのオフセットは324文字になりました。

慌てて、文書内のすべてのハイパーリンクを削除して、それが何をするのかを確認することにしました。 RemoveHyperlinksサブを見つけて24個のハイパーリンクを削除した後、Instr()の戻り値は20文字だけ消えていた（マジックナンバーmatchStart = matchStart - 1 - 20を減算すると正しい開始位置が得られる）。明らかに、私はすべての魔法の数字を避けたいですが、私は最後の20文字がどこから来ているのか分かりません。

すべてのフィールドのリンクを解除しようとしましたが、ハイパーリンクが削除された後にリンクを解除しませんでした。

matchStart = InStr(startPos, objRange.Text, match.submatches(0)) 
matchEnd = matchStart + Len(match.submatches(0)) 
Set subRange0 = objDoc.Range(matchStart, matchEnd) 

は私にmatch.submatches(0)異なるsubRange0.Textを与える理由は上の任意の考え？または、他の隠された文字がどこに見つかるかもしれませんか（削除される）？

Sub FixHighlightedText() 
    Dim objDoc As Document 
    Dim objRange As Range, subRange0 As Range 
    Dim matchStart As Long, matchEnd As Long, startPos As Long 
    Dim regex As Object 
    Dim matches 

    Set objDoc = ActiveDocument 
    Set objRange = objDoc.Range(0, objDoc.Content.End) 
    startPos = 1 
    Set regex = CreateObject("VBScript.RegExp") 

    Call RemoveHyperlinks 

    With regex 
     .Pattern = "((\([a-zA-Z]*?[-]?Time:.*?\})[a-zA-Z0-9]{0,3})" 
     .Global = True 
    End With 

    If regex.test(objRange.Text) Then 
     Set matches = regex.Execute(objRange.Text) 

     Debug.Print "Document has " & matches.Count & " matches" 
     Debug.Print "Document range is " & objRange.Start & " to " & objRange.End 
     Debug.Print "FirstIndex = " & matches(0).FirstIndex 

     For Each match In matches 
      matchStart = InStr(startPos, objRange.Text, match.submatches(0)) 
      startPos = matchStart + Len(match.submatches(0)) 
      If matchStart > 0 Then 
       matchStart = matchStart - 1 
       matchEnd = matchStart + Len(match.submatches(0)) 
       Set subRange0 = objDoc.Range(matchStart, matchEnd) 

       Debug.Print "Match starts at " & matchStart & " and ends at " & (matchStart + Len(match.submatches(1))) 
       Debug.Print " match0 text = " & match.submatches(0) 
       Debug.Print " subrange0 text = " & subRange0.Text 
      Else 
       Debug.Print "Match mysteriously not found in text" 
      End If 
     Next match 
    Else 
     Debug.Print "No regex matches" 
    End If 
End Sub 

Sub RemoveHyperlinks() 
    Dim link, cnt As Long, linkRange As Range, i As Long 

    cnt = 0 

    For i = ActiveDocument.Hyperlinks.Count To 1 Step -1 
     With ActiveDocument.Hyperlinks(i) 
      .TextToDisplay = .TextToDisplay & " (" & .Address & ")" 
      Set linkRange = .Range 
     End With 

     ActiveDocument.Hyperlinks(i).Delete 

     With linkRange.Font 
      .Underline = wdUnderlineNone 
      .ColorIndex = wdAuto 
     End With 

     cnt = cnt + 1 
    Next i 
    Debug.Print "Removed " & cnt & " link(s)" 
End Sub 

Sub RemoveFields() 
    Dim cnt As Long, i As Long 

    cnt = 0 

    For i = ActiveDocument.Fields.Count To 1 Step -1 
     ActiveDocument.Fields(i).Unlink 

     cnt = cnt + 1 
    Next i 
    Debug.Print "Removed " & cnt & " field(s)" 
End Sub 

Answer 1

私は、この質問に対する選択された回答のヒントを見つけました：vbscript: replace text in activedocument with hyperlink。

本来、Instr()はWordのWYSIWYG機能ではうまく機能しませんが、Findメソッドは適切な範囲で選択を行います。ハイパーリンクを削除する必要も、他の不思議な隠されたテキストを心配する必要もありません。

コードは次のようになります。

Sub FixHighlightedText() 
    Dim objDoc As Document 
    Dim objRange As Range 
    Dim startPos As Long 
    Dim regex As Object 
    Dim matches 

    Set objDoc = ActiveDocument 
    Set objRange = objDoc.Range 
    startPos = 1 
    Set regex = CreateObject("VBScript.RegExp") 

    With regex 
     .Pattern = "((\([a-zA-Z]*?[-]?Time:.*?\})[a-zA-Z0-9]{0,3})" 
     .Global = True 
    End With 

    If regex.test(objRange.Text) Then 
     Set matches = regex.Execute(objRange.Text) 

     Debug.Print "Document has " & matches.Count & " matches" 
     Debug.Print "Document range is " & objRange.Start & " to " & objRange.End 
     Debug.Print "FirstIndex = " & matches(0).FirstIndex 

     For Each match In matches 
      Set objRange = objDoc.Range(startPos, objDoc.Content.End) 
      With objRange.Find 
       .Text = match.submatches(0) 
       .MatchWholeWord = True 
       .MatchCase = True 
       .Wrap = wdFindStop 
       .Execute 
      End With 
      startPos = objRange.End 
      Debug.Print "Match starts at " & objRange.Start & " and ends at " & objRange.End 
      Debug.Print " match0 text = " & match.submatches(0) 
      Debug.Print " subrange text = " & objRange.Text 
     Next match 
    Else 
     Debug.Print "No regex matches" 
    End If 
End Sub