2016-12-01 6 views
1

、私は「いつもこの会話でメッセージを移動する」を有効にすると、それがされます:正しく動作する「setAlwaysMoveConversation」を作成するにはどうすればよいですか? Outlookで

  1. 移動から送信済みアイテム
  2. を含め、対象フォルダへの会話内のすべてのメッセージ、その瞬間に、すべてのメッセージを受信しました。その会話はターゲットフォルダに移動さ​​れます。ただし、すべてのメッセージを送信しました。このメッセージは送信済みアイテムフォルダに残ります。

ステップ1で送信アイテムに既に含まれているものを除外します。

背景:私たちは共有のメールボックスを使用しています。私たちはあまりにも多くのメールがあるため、私たちのためにすばやいステップを取ることはできません。 私は、ユーザー名を取得し、対応するフォルダに移動する(常に移動できる)ボタンを持つサブを作成しました。

しかし、私は送信されたアイテムを残しておきたい - これは可能なのか、それとも自分の "alwaysMoveMessages"機能を作るべきか?

ありがとうございました!

+1

http://stackoverflow.com/a/36467744/4539709 – 0m3r

+0

@ Om3r、ありがとう!それだけが必要。私は、送信アイテムフォルダを除外する条件を追加します。 – Dimas

+0

ここに回答として投稿してください – Dimas

答えて

2

Conversation.GetRootItemsSimpleItemsルートアイテムまたはスレッドのすべてのルートアイテムを含むコレクションConversation.GetTable会話内のすべてのアイテムを含むテーブルオブジェクト。

サンプルコード

Option Explicit 
Sub MoveConv() 
    Dim olNs As NameSpace 
    Dim Inbox As Outlook.MAPIFolder 
    Dim SubFolder As Outlook.MAPIFolder 
    Dim SelectedItem As Object 
    Dim Item As Outlook.MailItem ' Mail Item 
    Dim Folder As Outlook.MAPIFolder ' Current Item's Folder 
    Dim Conversation As Outlook.Conversation ' Get the conversation 
    Dim ItemsTable As Outlook.Table ' Conversation table object 
    Dim MailItem As Object 

    Set olNs = Application.GetNamespace("MAPI") 
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox) 

' On Error GoTo MsgErr 
' // Must Selected Item. 
    Set SelectedItem = Application.ActiveExplorer.Selection.Item(1) 

' // If Item = a MailItem. 
    If TypeOf SelectedItem Is Outlook.MailItem Then 
     Set Item = SelectedItem 
     Set Conversation = Item.GetConversation 

     If Not IsNull(Conversation) Then 
      Set ItemsTable = Conversation.GetTable 

      For Each MailItem In Conversation.GetRootItems ' Items in the conv. 
       If TypeOf MailItem Is Outlook.MailItem Then 
        Set Item = MailItem 
        Set Folder = Item.Parent 
        Set SubFolder = Inbox.Folders("Temp") ' Move to Temp Folder 
        Debug.Print Item.ConversationID & " In Folder " & Folder.Name 
        GetConv Item, Conversation 
        Item.Move SubFolder 
       End If 
      Next 
     End If 
    End If 

MsgErr_Exit: 
    Set olNs = Nothing 
    Set Inbox = Nothing 
    Set Item = Nothing 
    Set SelectedItem = Nothing 
    Set MailItem = Nothing 
    Exit Sub 

'// Error information 
MsgErr: 
    MsgBox "Err." _ 
     & vbCrLf & "Error Number: " & Err.Number _ 
     & vbCrLf & "Error Description: " & Err.Description _ 
     , vbCritical, "Error!" 
    Resume MsgErr_Exit 
End Sub 

Function GetConv(Item As Object, Conversation As Outlook.Conversation) 
    Dim Items As Outlook.SimpleItems 
    Dim MailItem As Object 
    Dim Folder As Outlook.Folder 
    Dim olNs As NameSpace 
    Dim Inbox As Outlook.MAPIFolder 
    Dim SubFolder As Outlook.MAPIFolder 

    Set olNs = Application.GetNamespace("MAPI") 
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox) 
    Set Items = Conversation.GetChildren(Item) 

    If Items.Count > 0 Then 
     For Each MailItem In Items 
      If TypeOf MailItem Is Outlook.MailItem Then 
       Set Item = MailItem 
       Set Folder = Item.Parent 
       Set SubFolder = Inbox.Folders("Temp") 
       Debug.Print Item.ConversationID & " In Folder " & Folder.Name 
       Item.Move SubFolder 
      End If 
      GetConv Item, Conversation 
     Next 
    End If 
End Function 
関連する問題