我的垃圾邮件文件夹中充斥着看似西里尔字母的邮件。如果邮件正文或邮件主题为西里尔字母,我想将其永久删除。

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

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

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

最佳答案

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

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

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

  • 包含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
    

    10-08 03:40