Question

经过大量搜索之后，我发现下面的代码将电子邮件移动到特定文件夹。但是，仅当整个电子邮件地址与代码中的硬编码电子邮件地址匹配时，此代码才移动电子邮件。是否可以从“ @ gmail.com”或“ @ msn.com”等特定域移动所有电子邮件？

    Option Explicit
Public Sub Filter_Move_Emails()
'   // Declare your Variables
    Dim Inbox As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim Item As Object
    Dim Items As Outlook.Items
    Dim lngCount As Long
    Dim AddressPart() As String

'    Set Inbox Reference
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items

'   // Loop through the Items in the folder backwards
    For lngCount = Items.Count To 1 Step -1
        Set Item = Items(lngCount)

        If Item.Class = olMail Then
            AddressPart = Split(Item.SenderEmailAddress, "@")
            Select Case LCase(AddressPart(UBound(AddressPart)))

'               // Email_One
                Case "gmail.com"

'                   // Set SubFolder of Inbox
                    Set SubFolder = Inbox.Folders("Filtered")
                    Set Item = Items.Find("[SenderEmailAddress] = 'ABC@gmail.com'")
                    If TypeName(Item) <> "Nothing" Then
'                       // Mark As Read
                        Item.UnRead = False
'                       // Move Mail Item to sub Folder
                        Item.Move SubFolder
                    End If

            End Select
        End If
    Next lngCount

End Sub

Answer 1

您正在检查整个SenderEmailAddress，而不仅仅是域部分。

也许最简单的方法是在“ @”上使用Split，然后测试第二部分：

Dim AddressPart() As String

:  :  :

AddressPart = Split(Item.SenderEmailAddress,"@")
Select Case LCase(AddressPart(UBound(AddressPart)))
  Case "gmail.com"

  :  :  :

  Case "google.com"

  :  :  :

  Case Else

  :  :  :

End Select

Case Else是可选的。如有必要，您可以用来处理所有其他域。

其他问题

我从未发现On Error GoTo Label的用途，也不明白为什么这么多“专家”将它们包含在他们的代码中。 （如果任何人知道用途，请添加描述该用途的注释。）建议您删除所有此错误代码。没有此代码，任何错误都将导致代码在导致该错误的语句上停止。有些错误是暂时的，只需重新启动代码即可清除错误。如果错误不是暂时的，则需要确定该语句为什么给出错误以及如何避免该错误。通常，您可以添加针对潜在错误条件的测试。该项目可能不是MailItem，并且没有属性SenderEmailAddress。如果错误无法避免，请尝试以下操作：

Dim ErrNum As Long

  :  :  :

ErrNum = 0
On Error Resume Next
' Statement that gives error
ErrNum = Err.Number
On Error Goto 0
If ErrNum <> 0 Then
  ' Code to handle error 
Endif

我记得标准安装只有一个收件箱，而olNs.GetDefaultFolder(olFolderInbox)返回了对该收件箱的引用。现在，该标准似乎是每个电子邮件帐户一个收件箱，再加上“ Outlook数据文件”中的一个，默认情况下是“ Outlook数据文件”中未使用的收件箱。如果您的代码找不到任何电子邮件，请回来，我将告诉您如何引用正确的收件箱。

通过电子邮件域将电子邮件移动到特定文件夹

1 个答案: