Перенести почту Outlook из одного почтового ящика в другую папку в том же почтовом ящике

Question

У меня есть несколько почтовых ящиков, которые можно увидеть в моем профиле Outlook. Один из почтовых ящиков, назовем его «Почтовый ящик - HUR», получает сообщения постоянно. в настоящее время одна из моих сотрудников ежедневно входит в почтовый ящик этого почтового ящика и перемещает (перетаскивает) сообщения в подпапку входящего почтового ящика, называемого Архивом (мы - образная партия!), если сообщения больше 24 часов.

Можно ли настроить макрос для выполнения этой задачи? Я знаю свой простой способ вокруг VBA, но никогда не использовал его с Outlook и не могу определить детали пространства имен, чтобы указать мне на правильный почтовый ящик вместо моего почтового ящика.

К сожалению, у меня нет доступа к серверу Exchange, только с использованием Outlook-клиента.

Любая помощь, которую может оказать любой человек, будет отличной.

Answer 1

Необходимо установить правило почтового ящика. Инструменты | Мастер правил

Если вы используете Exchange-сервер, у вас есть правило Outlook, чтобы переместить электронные письма в определенную папку, затем с помощью диспетчера почтовых ящиков в Exchange удалите сообщения из этой папки через определенный промежуток времени. См. Это article для получения дополнительной информации.

Answer 2

Вы хотели бы попробовать:

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 

Answer 3

Fionnuala вы рок!

Я искал решение подобной проблемы в течение нескольких месяцев. С моими корпоративными ограничениями я не смог использовать UDF (отлично работал на моем личном); В суб MoveOldEmail, вместо этого я использовал:

Set objMoveFolder = GetNamespace("MAPI").PickFolder 

Прохладный Дело в том, что это, кажется, чтобы позволить мне перемещаться между учетными записями электронной почты, что я связанных с моим Outlook (до АМФ не выясняет, по крайней мере).