如何将Outlook收件箱中具有特定主题的邮件项移动到特定文件夹/子文件夹? [英] How can I move Mails Items from Outlook Inbox with specific subject to specific folder/sub folder?

问题描述

我在Outlook中的邮件具有所有特定主题.我有一个包含主题和文件夹名称的Excel工作表.

My mails in Outlook has all specific subjects. I have a Excel Sheet which has subject and Folder Name.

我已经从 Stackoverflow

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

    On Error GoTo MsgErr
    '// 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.Item(lngCount)

        Debug.Print Item.Subject

        If Item.Class = olMail Then
            '// Set SubFolder of Inbox
            Set SubFolder = Inbox.Folders("Temp")
            '// Mark As Read
            Item.UnRead = False
            '// Move Mail Item to sub Folder
            Item.Move SubFolder
        End If
    Next lngCount

MsgErr_Exit:
    Set Inbox = Nothing
    Set SubFolder = Nothing
    Set olNs = Nothing
    Set Item = Nothing

Exit Sub

'// Error information
MsgErr:
   MsgBox "An unexpected Error has occurred." _
     & vbCrLf & "Error Number: " & Err.Number _
     & vbCrLf & "Error Description: " & Err.Description _
     , vbCritical, "Error!"
  Resume MsgErr_Exit
End Sub

我希望代码读取活动的工作表列，如下所示:

I want the code to read the active sheet columns, as follow:

Subject.mail   folder_name
    A                1
    B                2
    C                3

例如，邮件在主题"为"A"的收件箱中，则必须将该邮件放置在文件夹"1"中.

For example Mail in the Inbox with subject "A" then it has to place that mail in folder "1".

如何循环播放?看Sheet1并读取它必须移动到哪个子文件夹?

How do I loop? to look at the Sheet1 and to read to which sub folder it has to move ?

推荐答案

您执行此操作的选项很少，最简单的方法是从Outlook内部运行Outlook VBA代码，因此您无需进行大量引用问题，但同时如果您坚持要在Excel文件中包含主题和文件夹列表，则最好从Excel中运行它，但这是问题所在:您最好不要尝试运行代码从Excel中获取，因为Microsoft不支持该方法，所以最好的方法是在Excel VBA中编写代码，同样，您可以进行后期(运行时)绑定或早期绑定，但是我更喜欢早期绑定以使用智能来更好地引用Outlook对象.并避免后期绑定性能和/或调试问题.

You have few options to do this, the painless one is to run Outlook VBA code from inside outlook so you don't need to go through a lot of referencing problem, but at the same time if you are insisting in having your list of subjects and folder in an Excel file, then it is better to run it from Excel, but here is the issue: You'd better not try to run the code from Excel because Microsoft is not supporting that method, so the best way is to write the code in Excel VBA, and again you can do late (runtime) binding or early binding, but I prefer early binding to use intellisence for better referencing outlook objects and avoid late binding performance and/or debugging problems.

以下是代码以及如何使用它:

Here is the code and how you should use it:

转到具有主题和文件夹列表的excel文件，或创建一个新文件.按ALT + F11转到VBE.在左侧面板(项目浏览器)上，右键单击并插入一个模块.将此代码粘贴到那里:

Go to the excel file that you have your subject and folders list or create a new one. Hit ALT+F11 to go to VBE. On the left panel (project explorer) right click and insert a module. Paste this code in there:

Option Explicit
Public Sub MoveEmailsToFolders()
    'arr will be a 2D array sitting in an Excel file, 1st col=subject, 2nd col=folder name
    '   // Declare your Variables
    Dim i As Long
    Dim rowCount As Integer
    Dim strSubjec As String
    Dim strFolder As String

    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim myFolder As Outlook.Folder
    Dim Item As Object

    Dim Inbox As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder

    Dim lngCount As Long
    Dim Items As Outlook.Items
    Dim arr() As Variant 'store Excel table as an array for faster iterations
    Dim WS As Worksheet

    'On Error GoTo MsgErr

    'Set Excel references
    Set WS = ActiveSheet
    If WS.ListObjects.Count = 0 Then
        MsgBox "Activesheet did not have the Excel table containing Subjects and Outlook Folder Names", vbCritical, "Error"
        Exit Sub
    Else
        arr = WS.ListObjects(1).DataBodyRange.Value
        rowCount = UBound(arr, 2)
        If rowCount = 0 Then
            MsgBox "Excel table does not have rows.", vbCritical, "Error"
            Exit Sub
        End If
    End If


    'Set Outlook Inbox Reference
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set myFolder = olNs.GetDefaultFolder(olFolderInbox)

    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
        strFolder = ""
        Set Item = Items.Item(lngCount)

        'Debug.Print Item.Subject

        If Item.Class = olMail Then
            'Determine whether subject is among the subjects in the Excel table
            For i = 1 To rowCount
                If arr(i, 1) = Item.Subject Then
                    strFolder = arr(i, 2)

                    '// Set SubFolder of Inbox, read the appropriate folder name from table in Excel
                    Set SubFolder = Inbox.Folders(strFolder)
                    '// Mark As Read
                    Item.UnRead = False
                    '// Move Mail Item to sub Folder
                    Item.Move SubFolder
                    Exit For
                    End If
                Next i
            End If

      Next lngCount

  MsgErr_Exit:
    Set Inbox = Nothing
      Set SubFolder = Nothing
    Set olNs = Nothing
    Set Item = Nothing

    Exit Sub

 '// Error information
MsgErr:
    MsgBox "An unexpected Error has occurred." _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
  Resume MsgErr_Exit
End Sub

设置参考:

要使用Outlook对象，请在Excel VBE中转到工具，参考"并检查Microsoft Outlook对象库.

To use outlook objects, in Excel VBE go to Tools, References and check Microsoft Outlook object library.

设置Excel工作表:

在Excel工作表中，创建一个包含两列的表，第一列包含电子邮件主题，第二列包含要将这些电子邮件移动到的文件夹.

In an Excel sheet, create a table with two columns that the first column contains email subjects and the second column contains folders to which you want those emails to be moved.

然后，插入一个形状，然后在该形状上单击鼠标右键，然后分配一个宏，找到该宏的名称(MoveEmailsToFolders)，然后单击确定".

Then, insert a shape and right click on that and Assign a Macro, find the name of the macro (MoveEmailsToFolders) and click ok.

建议:

您可以开发更多代码以忽略大小写.为此，请替换此行:

You can develop the code more to disregard matchcase. To do that replace this line:

arr(i, 1) = Item.Subject

具有:

Ucase(arr(i, 1)) = Ucase(Item.Subject)

此外，您可以移动包含主题的电子邮件，而不是匹配精确的标题，例如，如果电子邮件主题具有测试"，或以测试"开头，或以测试"结尾，然后将其移动到相应的文件夹.然后，比较子句将是:

Also, you can move the emails that contain the subject rather than matching an exact title, for example if an email subject had "test", or begins with "test", or ends with "test", then move it to the corresponding folder. Then, the comparison clause would be:

 If arr(i, 1) Like Item.Subject & "*" Then 'begins with
 If arr(i, 1) Like  "*" & Item.Subject & "*" Then 'contains
 If arr(i, 1) Like  "*" & Item.Subject Then 'ends with

希望这会有所帮助！请打勾，以使其正确回答您的问题

Hope this helps! Please hit the check mark to make this as the right answer to your questions if it did

这篇关于如何将Outlook收件箱中具有特定主题的邮件项移动到特定文件夹/子文件夹?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！