Question

我的用户希望根据发件人的电子邮件地址中的第一个字母对收到的电子邮件进行排序。我在其他问题中发现了一些问题，但实际上我根据他们的电子邮件地址排序时遇到了麻烦。

Sub FilterTest()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim MyFolder As Outlook.MAPIFolder
Dim SenderName As String

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = Application.Session.Folders("me@company.com").Folders("Inbox")
Set MyFolder = Nothing

For i = olInbox.Items.Count To olInbox.Items.Count Step -1
    olInbox.Items.Item (i)
    SenderName = (olInbox.Items.Item(i).SenderEmailAddress)


        If SenderName Like "a*" Or SenderName Like "b*" Or SenderName Like "c*" Or SenderName Like "d*" Or SenderName Like "e*" Or SenderName Like "f*" Or SenderName Like "g*" Then
            MsgBox ("From a-g")
            Set MyFolder = Application.Session.Folders("me@company.com").Folders("test")
        End If
        If SenderName Like "h*" Or SenderName Like "i*" Or SenderName Like "j*" Or SenderName Like "k*" Or SenderName Like "l*" Or SenderName Like "m*" Or SenderName Like "n*" Or SenderName Like "o*" Then
            MsgBox ("From h-o")
            Set MyFolder = Application.Session.Folders("me@company.com").Folders("test 2")
        End If
        If SenderName Like "p*" Or SenderName Like "q*" Or SenderName Like "r*" Or SenderName Like "s*" Or SenderName Like "t*" Or SenderName Like "u*" Or SenderName Like "v*" Or SenderName Like "w*" Or SenderName Like "x*" Or SenderName Like "y*" Or SenderName Like "z*" Then
            MsgBox ("From p-z")
            Set MyFolder = Application.Session.Folders("me@company.com").Folders("test 3")
        End If

        If MyFolder Is Nothing Then
            MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
        Else
            olInbox.Items.Item(i).Move MyFolder
        End If
Next
End Sub

我确信有更好的方法可以做到这一点，但我什么都没得到...... 它永远不会进入任何if语句。

任何人都知道如何使这段代码有效吗？或者可能是另一种基于电子邮件地址的第一个字母排序的方式？

Answer 1

下面是一个如何让它更具可读性的例子

如果oyu使用SmtpAddress你也不必担心x400的东西

SenderName = (olInbox.Items.Item(i).SmtpAddress)

    'A = 65
    'G = 71
    'H = 72
    'O = 79
    'P = 80
    'Z = 90
    Dim numericLetterValue As Integer

    numericLetterValue = Asc(UCase(Left(SenderName, 1)))
    If numericLetterValue > 64 And numericLetterValue < 72 Then
        MsgBox ("From a-g")
        Set MyFolder = Application.Session.Folders("me@company.com").Folders("test")
    ElseIf numericLetterValue > 71 And numericLetterValue < 80 Then
        MsgBox ("From h-o")
        Set MyFolder = Application.Session.Folders("me@company.com").Folders("test 2")
    ElseIf numericLetterValue > 79 And numericLetterValue < 91 Then
        MsgBox ("From p-z")
        Set MyFolder = Application.Session.Folders("me@company.com").Folders("test 3")
    ElseIf MyFolder Is Nothing Then
        MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
    Else
        olInbox.Items.Item(i).Move MyFolder
    End If

Answer 2

我发现问题只出现在内部电子邮件中，因为电子邮件地址是x400地址，而不是普通的name@company.com，因此需要更多解析

换句话说，这个脚本适用于我想要做的事情。

Answer 3

如果您可以稍微移动组，则可以将索引计算为文件夹名称数组：

>> aMap = Array("AH", "IP", "QZ", "QZ")
>> For nFL = Asc("A") To Asc("Z")
>>     WScript.Echo Chr(nFL), aMap((nFL - Asc("A"))\8)
>> Next
>>
A AH
B AH
C AH
D AH
E AH
F AH
G AH
H AH
I IP
J IP
K IP
L IP
M IP
N IP
O IP
P IP
Q QZ
R QZ
S QZ
T QZ
U QZ
V QZ
W QZ
X QZ
Y QZ
Z QZ
>>

Outlook排序电子邮件基于第一个字母

3 个答案: