将 Outlook 邮件从一个邮箱收件箱移动到同一邮箱中的不同文件夹

Question

我有几个邮箱，可以在我的 Outlook 配置文件中看到它们。其中一个邮箱，我们称之为“邮箱 - HUR”，不断收到消息。目前，我的团队成员每天都会进入此邮箱的收件箱，如果邮件已存在超过 24 小时，则将邮件移动（拖放）到收件箱中名为“存档”的子文件夹中（我们是一个富有想象力的人！）。

有什么方法可以设置宏来完成这项任务吗？我知道使用 VBA 的简单方法，但从未在 Outlook 中使用过它，并且无法找出命名空间详细信息来将我指向正确的邮箱而不是我的邮箱。

不幸的是我无法访问Exchange服务器，只能使用outlook客户端。

任何人能提供的任何帮助都会很棒。

Answer 1

您可能想尝试：

Sub MoveOldEmail()

Dim oItem As MailItem
Dim objMoveFolder As MAPIFolder
Dim objInboxFolder As MAPIFolder
Dim i As Integer

    Set objMoveFolder = GetFolder("Personal Folders\Inbox\Archive")
    Set objInboxFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

    For i = objInboxFolder.Items.Count - 1 To 0 Step -1

        With objInboxFolder.Items(i)

            ''Error 438 is returned when .receivedtime is not supported            
            On Error Resume Next

            If .ReceivedTime < DateAdd("h", -24, Now) Then
                If Err.Number = 0 Then
                    .Move objMoveFolder
                Else
                    Err.Clear
                End If
            End If
        End With

    Next

    Set objMoveFolder = Nothing
    Set objInboxFolder = Nothing

End Sub

Public Function GetFolder(strFolderPath As String) As MAPIFolder
'' strFolderPath needs to be something like
''   "Public Folders\All Public Folders\Company\Sales" or
''   "Personal Folders\Inbox\My Folder"

Dim objNS As NameSpace
Dim colFolders As Folders
Dim objFolder As MAPIFolder
Dim arrFolders() As String
Dim i As Long

On Error GoTo TrapError

    strFolderPath = Replace(strFolderPath, "/", "\")
    arrFolders() = Split(strFolderPath, "\")

    Set objNS = GetNamespace("MAPI")


    On Error Resume Next

    Set objFolder = objNS.Folders.Item(arrFolders(0))

    If Not objFolder Is Nothing Then
        For i = 1 To UBound(arrFolders)
            Set colFolders = objFolder.Folders
            Set objFolder = Nothing
            Set objFolder = colFolders.Item(arrFolders(i))

            If objFolder Is Nothing Then
                Exit For
            End If
        Next
    End If

On Error GoTo TrapError

    Set GetFolder = objFolder
    Set colFolders = Nothing
    Set objNS = Nothing

Exit_Proc:
    Exit Function

TrapError:
    MsgBox Err.Number & " " & Err.Description

End Function