代码之家  ›  专栏  ›  技术社区  ›  Shane Miskin

如何确定文本是否为西里尔文字?

  •  3
  • Shane Miskin  · 技术社区  · 18 年前

    我的“垃圾邮件”文件夹中充满了用西里尔字母组成的邮件。如果邮件正文或邮件主题是西里尔文,我想永久删除它。

    在我的屏幕上,我看到西里尔字母,但当我在Outlook中的VBA中遍历邮件时,邮件的“Subject”属性返回问号。

    3 回复  |  直到 6 年前
        1
  •  3
  •   Mike Spross Alex Martelli    17 年前

    这个 String VB/VBA中的数据类型可以处理Unicode字符,但IDE本身在显示这些字符时有问题(因此会出现问号)。

    我写了一封信 IsCyrillic 可能对您有所帮助的功能。该函数采用单个 一串 参数和返回 True

    因此,我实际上有两个代码片段:

    • 异色的 作用这可以复制粘贴 进入新的VBA模块或添加到
    • 这个 Test 作用

    代码

    Option Explicit
    
    Public Const errInvalidArgument = 5
    
    ' Returns True if sText contains at least one Cyrillic character'
    ' NOTE: Assumes UTF-16 encoding'
    
    Public Function IsCyrillic(ByVal sText As String) As Boolean
    
        Dim i As Long
    
        ' Loop through each char. If we hit a Cryrillic char, return True.'
    
        For i = 1 To Len(sText)
    
            If IsCharCyrillic(Mid(sText, i, 1)) Then
                IsCyrillic = True
                Exit Function
            End If
    
        Next
    
    End Function
    
    ' Returns True if the given character is part of the Cyrillic alphabet'
    ' NOTE: Assumes UTF-16 encoding'
    
    Private Function IsCharCyrillic(ByVal sChar As String) As Boolean
    
        ' According to the first few Google pages I found, '
        ' Cyrillic is stored at U+400-U+52f                '
    
        Const CYRILLIC_START As Integer = &H400
        Const CYRILLIC_END  As Integer = &H52F
    
        ' A (valid) single Unicode char will be two bytes long'
    
        If LenB(sChar) <> 2 Then
            Err.Raise errInvalidArgument, _
                "IsCharCyrillic", _
                "sChar must be a single Unicode character"
        End If
    
        ' Get Unicode value of character'
    
        Dim nCharCode As Integer
        nCharCode = AscW(sChar)
    
        ' Is char code in the range of the Cyrillic characters?'
    
        If (nCharCode >= CYRILLIC_START And nCharCode <= CYRILLIC_END) Then
            IsCharCyrillic = True
        End If
    
    End Function
    


    示例用法

    ' On my box, this code iterates through my Inbox. On your machine,'
    ' you may have to switch to your Inbox in Outlook before running this code.'
    ' I placed this code in `ThisOutlookSession` in the VBA editor. I called'
    ' it in the Immediate window by typing `ThisOutlookSession.TestIsCyrillic`'
    
    Public Sub TestIsCyrillic()
    
        Dim oItem As Object
        Dim oMailItem As MailItem
    
        For Each oItem In ThisOutlookSession.ActiveExplorer.CurrentFolder.Items
    
            If TypeOf oItem Is MailItem Then
    
                Set oMailItem = oItem
    
                If IsCyrillic(oMailItem.Subject) Then
    
                    ' I just printed out the offending subject line '
                    ' (it will display as ? marks, but I just       '
                    ' wanted to see it output something)            '
                    ' In your case, you could change this line to:  '
                    '                                               '
                    '     oMailItem.Delete                          '
                    '                                               '
                    ' to actually delete the message                '
    
                    Debug.Print oMailItem.Subject
    
                End If
    
            End If
    
        Next
    
    End Sub
    
        2
  •  0
  •   Jeff Atwood    18 年前

    消息的“Subject”属性返回一组问号。

        3
  •  0
  •   dbb    18 年前