1

我有一个用户想要根据发件人电子邮件地址中的第一个字母对收到的电子邮件进行排序。我在其他问题中发现了一些东西，但实际上我无法根据他们的电子邮件地址进行排序。

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 语句。

任何人都知道我怎样才能使这段代码工作？或者可能是基于电子邮件地址的第一个字母的另一种排序方式？

4

3 回答 3

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
于 2013-12-11T21:08:31.083 回答
0

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

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

于 2013-12-11T20:52:00.340 回答
0

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

>> 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
>>
于 2013-12-11T21:33:32.807 回答