Outlookでフォルダ作成

質問

Outlook2010を使用しています。
受信年月ごとに振り分けるマクロを作成しましたが、あくまでも既存フォルダへの振り分けしか対応していません。
新しい年月（例えば毎月１日とか年が変わったとか）の受信メールに対応するべくフォルダの自動作成を考えているのですが、サンプルとなるようなソースも見つからずどうしたものかと悩んでいます。
Outlookのマクロでフォルダ作成は実現できるものなのでしょうか？
できるのであればソースの例、もしくはサイト等を教えていただけないでしょうか。
よろしくお願いいたします。
なお、受信トレイと同階層にある振り分け用フォルダ内に年月のフォルダを作成したいです。

回答No.1

m3_maki

サンプルです。

Sub MoveMailItems()
　　Dim ns As NameSpace
　　Dim org As Folder
　　Dim dst As Folder
　　Dim i As Long
　　Dim ym As String

　　On Error GoTo 0

　　Set ns = Application.Session

　　Set org = ns.GetDefaultFolder(olFolderInbox)
　　Set dst = org.Parent.Folders("振り分け用フォルダ")

　　On Error GoTo Func_Err

　　For i = org.Items.Count To 1 Step -1
　　　　With org.Items(i)
　　　　　　ym = Format(.ReceivedTime, "yyyy年mm月")
　　　　　　.Move dst.Folders(ym)
　　　　End With
　　Next
Func_Exit:
　　Exit Sub

Func_Err:
　　If Err = -2147221233 Then
　　　　Debug.Print ym & " フォルダを作成します"
　　　　dst.Folders.Add ym
　　　　Resume
　　End If
　　MsgBox Err.Description
　　Resume Func_Exit
End Sub