Crie uma nova pasta para o novo nome do remetente e mova a mensagem para a nova pasta

Question

Antecedentes

Eu gostaria de ter o Outlook 2010 automaticamente mover e-mails para pastas designadas por o nome da pessoa. Por exemplo:

1. Clique em Regras
2. Clique em Gerenciar regras e amp; Alertas
3. Clique em Nova regra
4. Selecione "Mover mensagens de alguém para uma pasta"
5. Clique em Próximo

A seguinte caixa de diálogo é exibida:

Problema

Apróximapartegeralmenteéaseguinte:

1. Cliqueempeopleorpublicgroup
2. Selecioneapessoadesejada
3. Cliqueemspecified
4. Selecioneapastadesejada

Pergunta

Comovocêautomatizariaessastarefasmanuaisproblemáticas?Estaéalógicadanovaregraquegostariadecriar:

1. Recebaumanovamensagem.
2. Extraiaonomedoremetente.
3. Senãoexistir,crieumanovapastaemCaixadeentrada
4. Movaanovamensagemparaapastaatribuídaaonomedessapessoa

AchoqueissoexigiráumamacroVBA.

LinksRelacionados

• link
• link
• link
• link
• link
• link

Atualização 1

O código pode se assemelhar a algo como:

Public WithEvents myOlApp As Outlook.Application

Sub Initialize_handler()
    Set myOlApp = CreateObject("Outlook.Application")
End Sub

Private Sub myOlApp_NewMail()
    Dim myInbox As Outlook.MAPIFolder
    Dim myItem As Outlook.MailItem

    Set myInbox = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set mySenderName = myItem.SenderName

    On Error GoTo ErrorHandler
    Set myDestinationFolder = myInbox.Folders.Add(mySenderName, olFolderInbox)

    Set myItems = myInbox.Items
    Set myItem = myItems.Find("[SenderName] = " & mySenderName)
    myItem.Move myDestinationFolder

ErrorHandler:
    Resume Next
End Sub

Atualização nº 2

Divida o código da seguinte forma:

Enviou uma mensagem de teste e nada aconteceu. As instruções para realmente acionar uma mensagem quando uma nova mensagem chega são um pouco mais claras nos detalhes (por exemplo, nenhuma menção é feita sobre ThisOutlookSession e como usá-la).

Obrigado.

    

Answer 1

Esta pergunta frequentemente feita é respondida aqui.

link

Usa ItemAdd para fazer o que o Newmail, agora NewMailEx, faria.

No módulo ThisOutlookSesion

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace

  ' set object reference to default Inbox
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
' fires when new item added to default Inbox
' (per Application_Startup)

  On Error GoTo ErrorHandler

  Dim Msg As Outlook.MailItem
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim targetFolder As Outlook.MAPIFolder
  Dim senderName As String

  ' don't do anything for non-Mailitems
  If TypeName(item) <> "MailItem" Then GoTo ProgramExit

  Set Msg = item

  ' move received email to target folder based on sender name
  senderName = Msg.senderName

  If CheckForFolder(senderName) = False Then  ' Folder doesn't exist
    Set targetFolder = CreateSubFolder(senderName)
  Else
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set targetFolder = _
    objNS.GetDefaultFolder(olFolderInbox).Folders(senderName)
  End If

  Msg.Move targetFolder

ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Function CheckForFolder(strFolder As String) As Boolean
' looks for subfolder of specified folder, returns TRUE if folder exists.
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Dim FolderToCheck As Outlook.MAPIFolder

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

' try to set an object reference to specified folder
On Error Resume Next
Set FolderToCheck = olInbox.Folders(strFolder)
On Error Goto 0

If Not FolderTocheck Is Nothing Then
  CheckForFolder = True
End If

ExitProc:
Set FolderToCheck = Nothing
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function

Function CreateSubFolder(strFolder As String) As Outlook.MAPIFolder
' assumes folder doesn't exist, so only call if calling sub knows that
' the folder doesn't exist; returns a folder object to calling sub
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

Set CreateSubFolder = olInbox.Folders.Add(strFolder)

ExitProc:
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function

    

Answer 2

Eu esqueceria de usar completamente as regras e, em vez disso, cria uma macro VBA anexada ao NewMail que criará uma pasta (usando o Folders.Add method ) baseado no Propriedade SenderName e, em seguida, mova-o para lá com o href="http://msdn.microsoft.com/en-us/library/office/aa220127(v=office.11).aspx" do MailItem > Mover o método .