Тип данных String в VB / VBA может обрабатывать символы 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