フォルダーのツリー構造を複製するOutlookのマクロなんぞを

  • 投稿日:
  • by シゲル
  • カテゴリ:

仕事でOutlookを使っているんだけども、毎日数百通というメールを受信する上に、無数のサイトのRSSを購読しているんで、殆どの情報はExchange上に残さずに個人用フォルダ(PST)に移動させて、サーバーのメールボックスは常に500MBも使っていないような使い方を何年も続けている。サーバーにメールを置いておかないと、PSTを持っているマシンにリモート接続でもできない限り、全ての情報にアクセスできないというマイナス点はあるものの、それが必要なこともあまりないから関係ないかなと。

で、カレンダーの新年を迎えるごとに新しいPSTを作って、そっちに保存するように切り替えてるんだけど、年に1度の作業とはいえ、フォルダーのツリーを目で確認しながら1個ずつ作っていくのはとても面倒だと毎年感じていた。
かれこれ5年以上繰り返しておきながら、今年ついに一念発起。マクロでフォルダーのツリー構造を新しいPSTにコピーすることにした。

20140109184129.jpg

やることは簡単。
手動で新しいPSTを追加してから、マクロで、Outlookのプロファイルで見える全てのストアの中から、コピー元になるPSTと新しいPSTを選ぶだけ。あとは、マクロで階層構造をそのままターゲットのPSTに作っていく。もちろん、サブフォルダーも再帰的に。

あくまで自分用なので、一切のエラーハンドリングも気の利いたメッセージも表示しないけど、処理時間は数秒だし、ファイルが消えるようなこともなかったんで十分でしょ。

準備としては、

  1. プロジェクトにユーザーフォームを追加。
  2. コンボボックスをComboSource, ComboTargetとし、OKボタンは成り行きでStoreSelection_OKという名前になった。フォームの名前は何でもいいけど、既定のUserForm1をそのまま使用。

そして、フォームをクリックして選択してから、メニューの[挿入]-[標準モジュール]で新しいモジュールを挿入し、表示された空のウィンドウに以下のコードを貼りつける。

Option Explicit

Public gSourceStoreIndex As Integer
Public gTargetStoreIndex As Integer

Public Sub CopyFolderHierarchy()
On Error GoTo On_Error

Dim Session As Outlook.NameSpace
Dim Store As Outlook.Store
Dim Stores As Outlook.Stores
Dim SourceStore As Store
Dim TargetStore As Store

Set Session = Application.Session
Set Stores = Session.Stores
For Each Store In Stores
UserForm1.ComboSource.AddItem (Store.DisplayName)
UserForm1.ComboTarget.AddItem (Store.DisplayName)
Next Store
UserForm1.Show

If gSourceStoreIndex <> gTargetStoreIndex Then
Set SourceStore = Stores(gSourceStoreIndex)
Set TargetStore = Stores(gTargetStoreIndex)
SyncHierarchy SourceStore.GetRootFolder, TargetStore.GetRootFolder
End If

Exiting:
Set Session = Nothing
Exit Sub
On_Error:
MsgBox "error=" & Err.Number & " " & Err.Description
Resume Exiting
End Sub

Private Function SyncHierarchy(srcFolder As Folder, tgtFolder As Folder)
Dim subFolders As Folders
Dim subFolder As Folder
Dim newFolder As Folder

Set subFolders = srcFolder.Folders
For Each subFolder In subFolders
If (subFolder.Name <> "削除済みアイテム") And (subFolder.Name <> "検索フォルダー") Then
Set newFolder = tgtFolder.Folders.Add(subFolder.Name)
If subFolder.Folders.Count > 0 Then
SyncHierarchy subFolder, newFolder
End If
End If
Next subFolder
Set subFolder = Nothing
Set newFolder = Nothing
End Function

さらに、フォームのOKボタンをダブルクリックして、ハンドラーのコードを以下のように書く。

Private Sub StoreSelection_OK_Click()
gSourceStoreIndex = UserForm1.ComboSource.ListIndex + 1
gTargetStoreIndex = UserForm1.ComboTarget.ListIndex + 1
Unload Me
End Sub

以上。

selfcert.exeで自己署名証明書を作ってマクロに署名して、セキュリティセンターでマクロの実行を許可してからマクロを実行すると、指定したストア間で簡単にツリー構造が複製できる。

自分で作っておきながら、テストもしないで一発でツリーがコピーできたときは感激しちゃった。楽すぎる！あとは、RSSやクライアントルールの設定で、保存先のフォルダーを新しいPSTに変更するだけ。