右クリックメニューにフォルダーの移動コマンドを追加するマクロ


コメントにて以下のご要望をいただきました。


OUTLOOK2007を使用しています。
受信メールの自動で振り分けをしているのですが、
仕分ルールだけでは細かすぎるので、そのあと
フォルダに手動でメールの移動もしています。ただ、
毎回、ナビゲーションウィンドウを使いながら
ドラッグドロップをしています。メールが多いと
かなり効率が落ちます。
アドインか、マクロを導入することで、右クリックから
ワンクリックで選択したメールを移動する方法ないでしょうか。
よろしくお願いいたします。



Outlook ではアイテムを右クリックすると Application_ItemContextMenuDisplay というイベントが実行され、そのイベントの CommandBar オブジェクトのコントロールにボタンを追加することで、右クリックメニューを追加することができます。
マクロは以下のようなものになります。 
このマクロでは、受信トレイの下の AAA および BBB というフォルダーに選択したアイテムを移動するボタンを追加します。
フォルダー名を変更するときは AAA や BBB を変更してください。
また、フォルダーを追加したいときは AddMoveButton CommandBar, Selection, "フォルダー名" という行を他の AddMoveButton の行の次に追加してください。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemContextMenuDisplay(ByVal CommandBar As Office.CommandBar, ByVal Selection As Selection)
    If Selection.Count > 0 Then
        If Selection.Item(1).Class = olMail Then
            AddMoveButton CommandBar, Selection, "AAA"
            AddMoveButton CommandBar, Selection, "BBB"
        End If
    End If
End Sub
'
Private Sub AddMoveButton(ByVal oCommandBar As Office.CommandBar, ByVal colSelection As Selection, strFolder As String)
    Const FOLDER_MOVE_FACEID = 1679
    Dim cmdMove As Office.CommandBarButton
    '
    g_strEIDs = ""
    For i = 1 To colSelection.Count
        g_strEIDs = g_strEIDs & ";" & colSelection(i).EntryID
    Next
    '
    Set cmdMove = oCommandBar.Controls.Add(msoControlButton)
    With cmdMove
        .Style = msoButtonIconAndCaption
        .Caption = strFolder & " へ移動"
        .FaceId = FOLDER_MOVE_FACEID
        .OnAction = "Project1.ThisOutlookSession.MoveToFolder"
        .Tag = strFolder
    End With
End Sub
'
Private Sub MoveToFolder()
    Dim arrParam As Variant
    Dim strFolder As String
    Dim fldDest As Folder
    Dim objMove As Variant ' may be MailItem
    Dim i As Integer
    '
    If InStr(g_strEIDs, ";") = 0 Then Exit Sub
    arrParam = Split(g_strEIDs, ";")
    strFolder = ActiveExplorer.CommandBars.ActionControl.Tag
    Set fldDest = Session.GetDefaultFolder(olFolderInbox).Folders(strFolder)
    For i = 1 To UBound(arrParam)
        Set objMove = Session.GetItemFromID(arrParam(i))
        objMove.Move fldDest
    Next
End Sub

マクロの登録方法やメニューへの追加について

2017/01/13: コードに不具合があったため修正しました。

右クリックメニューにフォルダーの移動コマンドを追加するマクロ」への1件のフィードバック

  1. OutlookのVBAの情報は少なく、非常に参考にさせていただいています。

    このページの”右クリックメニューにフォルダーの移動コマンドを追加するマクロ”を使ってみましたが、
    バグと思われる症状があり、修正

    テストとして、受信トレイの下のホルダー2つ(AAAとBBB)を作成し、受信トレイのメールを右クリックすると、
    登録したホルダーへの移動がメニューに現れました (ここまではOK)。
    AAAへの移動を選択しても、2つ目のBBBホルダーへアイテムが移動されてしまいます。

    g_strEIDs のところに問題があるのかなとおもうのですが、修正の仕方がわかりません。
    ご教授いただけると幸いです。

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中