我的垃圾邮件文件夹里塞满了似乎是西里尔字母的邮件。如果邮件正文或邮件主题是西里尔文,我想永久删除它。
在我的屏幕上,我看到西里尔字符,但是当我在 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
消息的“主题”属性返回一堆问号。
一个经典的字符串编码问题。听起来该属性正在返回 ASCII,但您需要 UTF-8 或 Unicode。
在我看来,您已经有了一个简单的解决方案 - 只需查找任何带有(比如说)5个问号的主题行