【问题标题】:How can I determine if text is in Cyrillic characters?如何确定文本是否为西里尔字符?
【发布时间】:2010-09-17 10:17:55
【问题描述】:

我的垃圾邮件文件夹中塞满了似乎是西里尔字母的邮件。如果邮件正文或邮件主题是西里尔文,我想将其永久删除。

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

如何确定邮件的主题是否为西里尔字符?

(注意:我检查了“InternetCodepage”属性 - 它通常是西欧。)

【问题讨论】:

    标签: vba unicode outlook


    【解决方案1】:

    VB/VBA 中的String 数据类型可以处理Unicode 字符,但IDE 本身无法显示它们(因此出现了问号)。

    我写了一个IsCyrillic 函数可以帮助你。该函数采用单个String 参数,如果字符串包含至少一个西里尔字符,则返回True。我用 Outlook 2007 测试了这段代码,它似乎工作正常。为了测试它,我给自己发了几封主题行中带有西里尔文的电子邮件,并验证我的测试代码可以正确地从收件箱中的所有其他内容中挑选出这些电子邮件。

    所以,我其实有两个代码sn-ps:

    • 包含IsCyrillic 函数的代码。这个可以复制粘贴 到一个新的 VBA 模块或添加到 您已有的代码。
    • 我编写的Test 例程(在 Outlook VBA 中)用于测试代码是否确实有效。它演示了如何使用IsCyrillic 函数。

    代码

    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】:

    消息的“主题”属性返回一堆问号。

    一个经典的字符串编码问题。听起来该属性正在返回 ASCII,但您需要 UTF-8 或 Unicode。

    【讨论】:

      【解决方案3】:

      在我看来,您已经有了一个简单的解决方案 - 只需查找任何带有(比如说)5 个问号的主题行

      【讨论】:

      • 行不通。他的调试器没有显示该属性的真正含义。
      • 我试过了。乔尔完全正确。好像是“??????”但这个表达式是错误的:Message.Subject Like "[?][?][?]"。那些问号真的不存在。
      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 2016-06-15
      • 2016-11-04
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2019-08-18
      相关资源
      最近更新 更多