年、月、日の階層構造のフォルダーを作成してアイテムを移動するマクロ


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


お世話になります。今回初めてコメントをさせていただきます。Outlook2010、Outlook2013の環境で、決まった差出人のメールを、受信トレイ配下に階層深くチェックした後に、移動させたいのですが、その時にフォルダが存在しない時は、作成してメールを移動させたいのですが、1回目は階層深くフォルダを作成し、移動することはできるようになったのですが、翌日、同じマクロを実行すると、最階層の下にフォルダをまた、階層深く作成してしまって、どうにかして、最階層だけ作成して、メールを移動するようにしたいのですが、よくわからないのです。ご教授いただけると助かります。
受信トレイから→チェック済→年度→月→日に移動させたいのです。翌日は新しい日のフォルダが月の下に作成されて、メールが移動される。月が変わったら、新しく月と日のフォルダを作成して、日のフォルダにメールが移動される。年度が変わったら、年度、月、日のフォルダが作成され、新しい日のフォルダにメールが移動されるようにしたいのです。マクロVBAを作成した経験がなく、非常に困っております。どなたかご教授いただけると助かります。よろしくお願いいたします。


フォルダーが存在するかどうかを確認し、存在しない場合だけ作成するようにすれば、ご要望の動作は満たせるでしょう。
以下のようなマクロで実現できます。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub MoveByDate()
    Dim objItem As MailItem
    Dim dt As Date
    Dim fldInbox As Folder
    Dim fldChecked As Folder
    Dim fldYear As Folder
    Dim fldMonth As Folder
    Dim fldDay As Folder
    ' 現在開いているか選択しているアイテムを取得
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Set objItem = ActiveInspector.CurrentItem
    Else
        Set objItem = ActiveExplorer.Selection(1)
    End If
    '
    Set fldInbox = Session.GetDefaultFolder(olFolderInbox)
    Set fldChecked = GetOrCreateFolder(fldInbox, "チェック済み")
    dt = Now ' 今日の日付でフォルダーを作成
    ' フォルダをアイテムの受信日時により作成する場合は下記の記述を使用
    ' dt = objItem.ReceivedTime
    Set fldYear = GetOrCreateFolder(fldChecked, Year(dt))
    Set fldMonth = GetOrCreateFolder(fldYear, Month(dt))
    Set fldDay = GetOrCreateFolder(fldMonth, Day(dt))
    '
    objItem.Move fldDay
End Sub
'
Private Function GetOrCreateFolder(fldParent As Folder, strName As String)
    On Error Resume Next
    Dim fldSub As Folder
    For Each fldSub In fldParent.Folders
        If fldSub.Name = strName Then
            Set GetOrCreateFolder = fldSub
            Exit Function
        End If
    Next
    Set fldSub = fldParent.Folders.Add(strName)
    Set GetOrCreateFolder = fldSub
End Function

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

広告

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中