現在のビューをすべてのフォルダーに適用するマクロ


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


さて、早速ではありますが質問があります。
こちらのサイトで[現在のビューの設定をサブフォルダにコピーするマクロ]というページを見つけ、私はそのマクロの
Set fldCurrent = ActiveExplorer.CurrentFolder
という部分を
Set fldCurrent = Application.Session.Folders.Item(1)
に変換して現在のビューを送信トレイなども含めた全てのフォルダに一括コピーするマクロを作成しました。
しかし、このマクロは効力がpstファイルごとにしか適用されません。
ですので、現在のビューを全てのpstファイル中にある全てのフォルダに一括コピーするマクロを作成するのはどうすればよいのかご教示お願いします。
どうやらstoreオブジェクトを使うらしいというのはわかるのですが…



ご認識の通り Store オブジェクトを使うことで、全てのストアのフォルダー階層にアクセスすることができます。

マクロは以下のようになります。


' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub CopyViewToAllFolders()
    Dim viewDefault As View
    Dim itView As OlItemType
    Dim oneStore As Store
    ' 現在のビューの情報を取得
    Set viewDefault = ActiveExplorer.CurrentFolder.CurrentView
    itView = ActiveExplorer.CurrentFolder.DefaultItemType
    For Each oneStore In Session.Stores
        ' ストアの種類がパブリック フォルダーやほかのユーザーの場合は実行しない
        If oneStore.ExchangeStoreType = olPrimaryExchangeMailbox _
          Or oneStore.ExchangeStoreType = olNotExchange Then
            CopyViewToSubRecur oneStore.GetRootFolder(), viewDefault, itView
        End If
    Next
    MsgBox "ビューの適用が完了しました"
End Sub
'
Private Sub CopyViewToSubRecur(ByVal fldParent As Object, viewDefault As View, itView As OlItemType)
    Const VIEW_NAME = "初期ビュー" ' - ビューの名前を変更したい場合は、これを変更
    Dim fldSub As Folder
    Dim viewSub As View
    Dim strViewXml As String
    For Each fldSub In fldParent.Folders
        ' フォルダーの種類が現在のフォルダーと同じ場合のみビューを適用
        If fldSub.DefaultItemType = itView Then
            ' 同名のビューがあったら削除
            For Each viewSub In fldSub.Views
                If viewSub.Name = VIEW_NAME Then
                    viewSub.Delete
                    Exit For
                End If
            Next
            ' ビューを追加し、設定をコピー
            Set viewSub = fldSub.Views.Add(VIEW_NAME, viewDefault.ViewType, olViewSaveOptionThisFolderEveryone)
            viewSub.XML = viewDefault.XML
            viewSub.Save
            viewSub.Apply
            ' サブフォルダーを再帰的に処理
            CopyViewToSubRecur fldSub, viewDefault, itView
        End If
    Next
End Sub

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

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中