Как я могу определить, написан ли текст кириллицей?

StackOverflow https://stackoverflow.com/questions/206719

  •  03-07-2019
  •  | 
  •  

Вопрос

Моя папка нежелательной почты начала заполняться сообщениями, составленными, по-видимому, на кириллице.Если текст сообщения или тема сообщения написаны кириллицей, я хочу удалить их безвозвратно.

На моем экране я вижу символы кириллицы, но когда я перебираю сообщения в VBA в Outlook, свойство "Subject" сообщения возвращает вопросительные знаки.

Как я могу определить, написана ли тема сообщения кириллицей?

(Примечание:Я изучил свойство "InternetCodepage" - обычно оно западноевропейское.)

Это было полезно?

Решение

Тот Самый 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

Другие советы

свойство "Subject" сообщения возвращает кучу вопросительных знаков.

Классическая проблема с кодированием строк.Похоже, что это свойство возвращает ASCII, но вам нужен UTF-8 или Unicode.

Мне кажется, у вас уже есть простое решение - просто найдите любую строку темы с (скажем) 5 вопросительными знаками в ней

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top