如何将每个邮件从收件箱移动到子文件夹 [英] How to move each emails from inbox to a sub-folder

问题描述

我似乎在将邮件从收件箱移动到收件箱的子文件夹方面遇到问题。我一直以为我的代码正在工作，直到今天。我注意到这只是移动一半的电子邮件。我不需要移动所有代码，我有一个目的，但我只需要移动每个电子邮件，而不是所有的一次（我需要检查每个电子邮件）。请看下面我的代码。 myNamespace.Folders.Item（1）.Folders.Item（2）是我的主要收件箱。

  Sub MoveEachInboxItems（）
 Dim myNamespace As Outlook.NameSpace 
设置myNamespace = Application.GetNamespace（MAPI）
 
对于MyNamespace中的每个项目。 Folders.Item（1）.Folders.Item（2）.Items 
 Dim oMail As Outlook.MailItem：Set oMail = Item 
 Item.UnRead = True 
 Item.move myNamespace.Folders。项目（1）.Folders.Item（2）.Folders（其他电子邮件）
下一个
 End Sub 
  

$ b

noreferrer>这里是很好的链接

通过电子邮件地址将Outlook邮件移动到子文件夹

  Option Explicit 
 Public Sub Move_Items（）
'//声明变量
 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 
 
 On Error GoTo MsgErr 
'Set收件箱参考
设置olNs = Application.GetNamespace（MAPI）
设置Inbox = olNs.GetDefaultFolder（olFolderInbox）
设置Items = Inbox.Items 
 
' /循环通过文件夹中的项目
对于lngCount = Items.Count到1步-1 
设置项目=项目（lngCount）
 
如果Item.Class = olMail Then 
选择案例Item.SenderEmailAddress 
 
'// Email_One 
案例[e-mail]
'//设置收件箱的子邮件
 Set SubFolder = Inbox.Folders（Folder One）
 Set Item = Items.Find（[SenderEmailAddress] ='[e-mail]'）
如果TypeName（Item）<> Nothing然后
'//标记为已读
 Item.UnRead = False 
'//将邮件项移动到子文件夹
 Item.Move SubFolder 
 End If 
 
'// Email_Two 
案例[e-mail]
'//设置收件箱的子文件
 Set SubFolder = Inbox.Folders（Folder Two ）
 Set Item = Items.Find（[SenderEmailAddress] ='[e-mail]'）
如果TypeName（Item）<> Nothing然后
'//标记为已读
 Item.UnRead = False 
'//将邮件项移动到子文件夹
 Item.Move SubFolder 
 End If 
 
结束选择
结束If 
下一步lngCount 
 
 MsgErr_Exit：
设置收件箱=没有
设置SubFolder = Nothing 
 Set olNs = Nothing 
 Set Item = Nothing 
 Set Items = Nothing 
 
 Exit Sub 
 
'//错误信息
 MsgErr ：
 MsgBox发生意外错误。 _ 
& vbCrLf& 错误编号：& Err.Number _ 
& vbCrLf& 错误说明：& Err.Description _ 
，vbCritical，Error！ 
恢复MsgErr_Exit 
 End Sub 
  

或将所有邮件项目收件箱移动到子文件夹

  Option Explicit 
 Public Sub Move_Items（）
'//声明变量
 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 
 
错误GoTo MsgErr 
'设置收件箱参考
设置olNs = Application.GetNamespace（MAPI）
设置Inbox = olNs.GetDefaultFolder（olFolderInbox） 
设置Items = Inbox.Items 
 
'//回滚文件夹中的项
对于lngCount = Items.Count到1步-1 
设置项=项目（lngCount）
 
 Debug.Print Item.Subject 
 
如果Item.Class = olMail然后
'//设置Inbox的SubFolder 
设置SubFolder = Inbox.Folders（ Temp）
'//标记为已读
 Item.UnRead = False 
'//将邮件项移动到子文件夹
 Item.Move SubFolder 
 End If 
下一页lngCount 
 
 MsgErr_Exit：
设置收件箱=没有
设置SubFolder =没有
设置olNs =没有
设置项目=没有
 
退出子
 
'//错误信息
 MsgErr：
 MsgBox发生意外错误。 _ 
& vbCrLf& 错误编号：& Err.Number _ 
& vbCrLf& 错误说明：& Err.Description _ 
，vbCritical，Error！ 
恢复MsgErr_Exit 
 End Sub 
  

I seem to be getting issues with moving emails from inbox to a sub-folder of inbox. I always thought my code was working until today. I noticed it's only moving half of the emails. I do not need a "move all" code, I have a purpose for this but I just need to move each emails and not all at once (I needed to check each emails). Please take a look at my code below. myNamespace.Folders.Item(1).Folders.Item(2) is my main Inbox.

Sub MoveEachInboxItems()
    Dim myNamespace As Outlook.NameSpace
    Set myNamespace = Application.GetNamespace("MAPI")

    For Each Item In myNamespace.Folders.Item(1).Folders.Item(2).Items
        Dim oMail As Outlook.MailItem: Set oMail = Item
           Item.UnRead = True
           Item.move myNamespace.Folders.Item(1).Folders.Item(2).Folders("Other Emails")
    Next
End Sub

解决方案

here is good link

Moves Outlook Mail items to a Sub folder by Email address

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 Items As Outlook.Items
    Dim lngCount As Long

    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(lngCount)

        If Item.Class = olMail Then
            Select Case Item.SenderEmailAddress

'               // Email_One
                Case "[e-mail]"
'                   // Set SubFolder of Inbox
                    Set SubFolder = Inbox.Folders("Folder One")
                    Set Item = Items.Find("[SenderEmailAddress] = '[e-mail]'")
                    If TypeName(Item) <> "Nothing" Then
'                       // Mark As Read
                        Item.UnRead = False
'                       // Move Mail Item to sub Folder
                        Item.Move SubFolder
                    End If

'               // Email_Two
                Case "[e-mail]"
'                   // Set SubFolder of Inbox
                    Set SubFolder = Inbox.Folders("Folder Two")
                    Set Item = Items.Find("[SenderEmailAddress] = '[e-mail]'")
                    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

MsgErr_Exit:
    Set Inbox = Nothing
    Set SubFolder = Nothing
    Set olNs = Nothing
    Set Item = Nothing
    Set Items = 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

Or to move all Mail items Inbox to sub folder

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(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

这篇关于如何将每个邮件从收件箱移动到子文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！