2013-12-11 39 views
1

我有一個用戶想根據發件人的電子郵件地址中的第一個字母對收到的電子郵件進行分類。我在其他問題中發現了一些問題,但實際上根據他們的電子郵件地址排序時遇到了問題。Outlook分類電子郵件基於第一個字母

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("[email protected]").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("[email protected]").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("[email protected]").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("[email protected]").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語句的任何。

任何人都知道我可以如何使此代碼工作? 或者也許另一種方式來基於電子郵件地址的第一個字母進行排序?

+0

你就不能右鍵單擊郵件列表的標題(「從|主題」等),然後選擇「視圖設置」 ,然後點擊「Sor t ...「按鈕,然後從那裏從排序項目列表中選擇」到「?我不知道什麼版本的Outlook,但在我的它有這個選項。它是Office 2010 Outlook(實際Outlook版本14.0.xxxx)。 – mrunion

+0

我閱讀了代碼,看起來你想將它們分類到特定的文件夾中。我以前的評論將是無益的。 – mrunion

+0

您可以使用ucase和asc()的組合來獲取數值並實施更大的 - 然後比較排序,這將消除類似子句的需要 – Sorceri

回答

1

是一個例子,你如何讓它多一點可讀性

此外,如果奧尤使用Smtp地址你不應該擔心的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("[email protected]").Folders("test") 
    ElseIf numericLetterValue > 71 And numericLetterValue < 80 Then 
     MsgBox ("From h-o") 
     Set MyFolder = Application.Session.Folders("[email protected]").Folders("test 2") 
    ElseIf numericLetterValue > 79 And numericLetterValue < 91 Then 
     MsgBox ("From p-z") 
     Set MyFolder = Application.Session.Folders("[email protected]").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 
0

我發現這個問題只與內部電子郵件,因爲電子郵件地址就會出現,X400地址,而不是正常的[email protected]所以要採取多一點解析

在其他單詞,這個腳本適用於我想要做的事情。

下面
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 
>> 
+0

我不太確定我完全理解什麼是去這裏... – Schuyler

相關問題