Outlook 2007で受信トレイ内の現在アクティブな電子メールを別のフォルダに移動するスクリプトを作成する方法

Question

メールを保存したいが、適切なフォルダに移動することが苦になることがあります。どのように私は見ている電子メールを "バッファ"と呼ばれる特定のフォルダに移動するスクリプトを実行することができますか？

私はOutlook 2007を使用しています。

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

---

EDIT： ルールを通してのように、このプロセスを自動化するために作成することができる任意の基準がありません。それは私がそれを見つめているように私が作る判断の呼び出しです。

Answer 1

ここに私が使用しているコードがあります。

Sub MoveSelectedMessagesToFolder() 
'Originally written by Chewy Chong 
'Taken from http://verychewy.com/archive/2006/04/12/outlook-macro-to-move-an-email-to-folder.aspx 
'Thanks Chewy! 
'Ken 
On Error Resume Next 
    Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder 
    Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem 

    Set objNS = Application.GetNamespace("MAPI") 
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox) 
    'For the "Item" portion, I used the name of the folder exactly as it appear in the ToolTip when I hover over it. 
    Set objFolder = objNS.Folders.Item("Personal Folders").Folders.Item("Buffer") 

'Assume this is a mail folder 

    If objFolder Is Nothing Then 
     MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER" 
    End If 

    If Application.ActiveExplorer.Selection.Count = 0 Then 
     'Require that this procedure be called only when a message is selected 
     Exit Sub 
    End If 
    For Each objItem In Application.ActiveExplorer.Selection 
     If objFolder.DefaultItemType = olMailItem Then 
      If objItem.Class = olMail Then 
       objItem.Move objFolder 
      End If 
     End If 
    Next 

Answer 2

ツール] - > [ルール&アラート

は、次にリード/ /フォルダにそれらの任意の組み合わせを移動するとしてマーク/削除することがどんな基準合うすべてのメールを伝える新しいルールを作成します。

編集： ルールをしたくない場合は/フィットルールを作り、あなたがマクロ（ツール - >マクロ）を作成することができますすることはできませんフォルダに移動し、その後にそれをバインドしますショートカット。

Answer 3

このコードはうまくいく場合があります。

あなたのコードでは、objFolderはNothingに等しいかもしれませんが、手順を続行します。また、For Eachループは、各アイテムがメールアイテムであるとみなします。

Sub MoveSelectedMessagesToFolder() 
    Dim objNS As Outlook.NameSpace 
    Dim objFolder As Outlook.MAPIFolder 
    Dim obj As Object 
    Dim msg As Outlook.mailItem 

    Set objNS = Application.GetNamespace("MAPI") 
    On Error Resume Next 
    Set objFolder = objNS.Folders.item("Personal Folders").Folders.item("Buffer") 
    On Error GoTo 0 

    If objFolder Is Nothing Then 
    MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER" 
    Exit Sub 
    End If 

    For Each obj In ActiveExplorer.Selection 
    If TypeName(obj) = "MailItem" Then 
     Set msg = obj 
     msg.Move objFolder 
    End If 
    Next obj 

End Sub