vbscript 检测QQ邮箱和雅虎中国邮箱

Posted 2021-05-21

Sub existQQYahoo()
  Dim myrange As New myrange
  Dim frontRange As Range
  Set frontRange = myrange.frontPart
   frontRange.Select
   If InStr(Selection.Text, "@qq") > 0 Then
        Selection.HomeKey wdStory
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "@qq"
            .MatchWildcards = False
            .Replacement.Text = ""
            Do
            .Execute
                If Not .Found Then
                    Exit Do
                Else
                    Selection.Range.HighlightColorIndex = wdRed
                End If
            Loop
        End With
   End If
   
      If InStr(Selection.Text, "@yahoo") > 0 Then
        Selection.HomeKey wdStory
        With Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "@yahoo"
            .MatchWildcards = False
            .Replacement.Text = ""
            Do
            .Execute
                If Not .Found Then
                    Exit Do
                Else
                    Selection.Range.HighlightColorIndex = wdRed
                End If
            Loop
        End With
   End If
End Sub