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

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

1 голос
/ 16 декабря 2009

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

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

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

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

Ответы [ 3 ]

4 голосов
/ 16 декабря 2009

Вы можете попробовать: 

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
0 голосов
/ 18 декабря 2017

Фионнуала, ты рок!

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

Set objMoveFolder = GetNamespace("MAPI").PickFolder

Круто то, что это, кажется, позволяет мне перемещаться между учетными записями электронной почты, которые я связал с моим Outlook (пока корпорация не выяснит, по крайней мере).

0 голосов
/ 16 декабря 2009

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

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

...