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

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

10年以上前の記事ですが、令和の時代になってもアクセス数が多いので、念のため今でも動作することを確認し、ついでにスクリーンショットを追加しました。(2025/2/4)

仕事でOutlookを使っていますが、サポート業務ということで毎日数百通というメールを受信する上に、無数のサイトのRSSを購読しているので、殆どの情報はExchange上に残さずに個人用フォルダ(PST)に移動させて、サーバーのメールボックスは常に500MBも使っていないような使い方を何年も続けています。

サーバーにメールを残さない場合、PSTを持っているマシンにリモート接続できない限り、全てのメールにアクセスできないというデメリットはあるものの、あまり古いとキャッシュに表示されなくなるので、どっちもどっちだと感じています。

そういう使い方なので、カレンダーの新年を迎えるごとに新しいPSTを作って年毎にPSTを切り替える使い方をしているんですが、年に1度の作業とはいえ、フォルダーのツリーを目で確認しながら1個ずつフォルダーを作っていくのはとても面倒です。
かれこれ5年以上繰り返しておきながら、ようやく手作業からマクロに切り替えました。
以下に手順を説明しますので、参考にしてみてください。
なお、コードを見ていただければわかりますが、ゴミ箱や検索フォルダーは名指しでコピーしないようにしています。

20140109184129.jpg

やることは簡単です。
アカウント設定のデータファイルタブで新しいPSTを追加してから、以下のマクロで、Outlookのプロファイルで見える全てのストアの中から、コピー元になるPSTと新しいPSTを選ぶだけ。あとは、マクロが階層構造をそのままターゲットのPSTに作っていきます。もちろん、サブフォルダーも。

あくまで自分用なので、一切のエラーハンドリングも気の利いたメッセージも表示しませんが、処理時間は数秒ですし、これまで試した限り元のファイルが消えるようなこともなかったので十分でしょう。
ただし、このマクロのせいで何かが起きても責任は負えませんので、自己責任で使ってください。

作業としてはこんな感じです。

  1. リボンに開発タブを追加 (しなくてもALT+F11で出るかも？)。
  2. プロジェクトにユーザーフォームを追加。
  3. コンボボックスを2個配置し、それぞれComboSource, ComboTargetとし、OKボタンはStoreSelection_OKという名前にします。コードとの整合性があるので、部品の名前は同じにしてください。
    フォームの名前は何でもかまいません。既定のUserForm1をそのまま使用。
  4. モジュールを追加してメインのコードを貼りつけます。
  5. OKボタンをダブルクリックして、ボタンクリックに紐づいている関数をこのブログのコードで置き換えます。

まずは開発タブを追加。しなくても行けるとは思いますが、お好みで。

DevelopmentOption.png

[挿入]から[ユーザーフォーム]を選択します。

InsertModule.png

ツールボックスで部品を選んで、フォームにコンボボックスを2個、コマンドボタン？を1個配置します。
部品を選択してプロパティ画面でオブジェクト名を以下のように設定します。
コードの中でこれらのオブジェクト名を使っているので名前は合わせます。

20140109184129.jpg

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

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

MainCode.png

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

StoreSelection_OK.png

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

ButtonCode.png

以上です。

F5で実行して、表示されたフォームにストアの表示名が入っていて選択可能になっていることを確認してください。
マクロが無効になっていると表示される場合は、開発タブのマクロのセキュリティをクリックして、一時的に「すべてのマクロを有効にする」なりを選択してマクロが実行可能な状態に変更してください。

macrosecurity.png

あと、結構な確率でコンボボックスのリストが空っぽで表示されるようなので、コードを貼りつけた画面のデバッグメニューで以下の行などにブレークポイントを設定して一旦止めるとストアのリストが表示されるようです。コードの問題だとは思いますけど、毎日使うようなものでもないので深く調査することはしません。

SyncHierarchy SourceStore.GetRootFolder, TargetStore.GetRootFolder

しつこいようですが、自己責任でお使いください。