ビューをファイルにエクスポート・インポートするスクリプト


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


いつも大変お世話になっております。
可能であればマクロ作成をご検討頂きたいのです。
OS:Windows 7 Professional(64bit)
Outlook2013
【ビューの定義をエクスポート(インポート)するマクロ】
【印刷スタイルの定義をエクスポート(インポート)するマクロ】
ビューの定義や印刷スタイルの定義を社内で統一して利用したい。
私が現在設定しているビューを
PC内(Outlook2013)でコピーする事は出来ますが
別PC(Outlook2013)へビューや印刷スタイルの定義を
エクスポート(インポート)する事は出来ないでしょうか?
標準の機能として、これらの定義のエクスポート(インポート)はないようなので
マクロで作成可能であればお願いしたい次第です。
ビューについては
【現在のビューの設定をサブフォルダにコピーするマクロ】や
2014年2月22日 コメントでの要望を受けての
全てのストアのフォルダー階層にアクセス可能な
【現在のビューをすべてのフォルダーに適用するマクロ】
上記の2つのマクロをどうにかすれば可能なのでしょうか?
ご検討の程、よろしくお願い申し上げます。


まず、印刷スタイルの定義ですが、こちらは以下のファイルに保存されています。(ファイルに拡張子はありません)

    c:\users\ユーザー名\AppData\Roaming\Microsoft\Outlook\OutPrnt

このファイルを単にコピーすれば、他の環境に印刷スタイルの定義をコピーすることができます。

次に、ビューの設定ですが、こちらはご指摘のマクロでやっているように、View オブジェクトの XML プロパティの文字列をエクスポート・インポートすれば、他の環境にビューの定義をコピーすることができます。
ただし、自動書式についてはコピーすることはできません。

現在表示しているフォルダーの現在のビュー設定をファイルにエクスポートするスクリプトは以下のようになります。
複数の PC で実行することを想定したため、スクリプトとして実装しました。
この内容をメモ帳などのテキストエディタに貼り付け、拡張子を .vbs として保存し、ダブルクリックして実行してください。

' ここをトリプルクリックでスクリプト全体を選択できます。
Const VIEW_XML = "C:\temp\current.view" ' エクスポート先のファイル名
Dim olkApp
Dim objFSO
Dim curView
Dim stmXml
Dim strXml
Set olkApp = CreateObject("Outlook.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set curView = olkApp.ActiveExplorer.CurrentFolder.CurrentView
strXml = curView.XML
Set stmXml = objFSO.CreateTextFile(VIEW_XML)
' 1 行目はビューの名前と種類
stmXml.WriteLine curView.Name & vbTab & curView.ViewType
stmXml.Write strXml
stmXml.Close

また、上記のスクリプトでエクスポートしたビュー設定を、現在表示しているフォルダーにインポートするスクリプトは以下のようになります。

' ここをトリプルクリックでスクリプト全体を選択できます。
On Error Resume Next
Const VIEW_XML = "C:\temp\current.view" ' インポート先のファイル名
Dim olkApp
Dim objFSO
Dim stmXml
Dim strLine
Dim arrLine
Dim colViews
Dim curView
Set olkApp = CreateObject("Outlook.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set stmXml = objFSO.OpenTextFile(VIEW_XML, 1)
' 1 行目はビューの名前と種類
strLine = stmXml.ReadLine
arrLine = Split(strLine, vbTab)
Set colViews = olkApp.ActiveExplorer.CurrentFolder.Views
Set curView = colViews.Add(arrLine(0), arrLine(1), 0)
If Err.Number = 5 Then ' 同名のビューが存在した場合のエラー処理
    For Each curView In colViews
        ' 同名のビューを検索
        If curView.Name = arrLine(0) Then
            Exit For
        End If
    Next
End If
curView.XML = stmXml.ReadAll
curView.Save
curView.Apply
stmXml.Close

ビューをファイルにエクスポート・インポートするスクリプト」への3件のフィードバック

  1. 要望をお願いした者です。早々の対応ありがとうございます。

    ■印刷スタイルの定義
    ご指南頂きました場所のファイルを単にコピーすることにより
    他の環境に印刷スタイルの定義をコピーすることができました。
    ありがとうございました。

    ■ビュー設定

    結果は無事にビュー設定をインポートできました。
    ありがとうございました。

    途中、当方の力不足ですんなりとはいかず…。
    一応、解決した方法を残しておきます。

    テキストエディタに貼り付け、拡張子を .vbs として
    C:\vbsへimport、exportそれぞれ.vbs保存し、ダブルクリックいたしました。
    以下のエラーが発生致しました。

    スクリプト: C:\vbs\export.vbs
    行: 13
    文字: 1
    エラー: パスが見つかりません。
    コード: 800A004C
    ソース: Microsoft VBScript 実行時エラー

    まず3行目の
    Const VIEW_XML = “C:\temp\current.view” ‘ エクスポート先のファイル名
    C:\temp\が当該PCになかったのでC:\temp\を作成、再度export.vbsダブルクリックで
    エラー発生せず、current.viewが作成されました。

    別PCへC:\temp\current.view C:\vbs\export.vbs C:\vbs\inport.vbsをコピーし
    inport.vbsをダブルクリックで無事にビュー設定をインポートできました。
    ありがとうございました。

  2. (質問する場所がここでいいのか不明ですがコメントさせていただきます)

    いつもブログ拝見させていただいています。

    私は、ある会社で新人研修のスタッフを行っております。
    新入社員は一日の終わりに日報をメールで作成して送るのが義務に
    なっています。

    そこで新入社員が送信したメールデータをExcelファイルにエクスポートする
    マクロはございますでしょうか。
    (新入社員が日報を送ったかチェックするためです。)

    ■メール抽出条件
    ・件名が”【日報】”となっているもの
    ・日付を指定して抽出する
    ・受信フォルダを複数指定して抽出

    ■Excelに抽出する際に必要情報な情報
    ・件名
    ・差出人(CC情報も含む)
    ・宛先

    ご教授頂きたく、宜しくお願い致します。

  3. ① ビューをファイルにエクスポート(フォルダ、ファイル名指定版)

    On Error Resume Next

    Dim objExcel
    Dim VIEW_XML
    Dim olkApp
    Dim objFSO
    Dim curView
    Dim stmXml
    Dim strXml
    Set objExcel = CreateObject(“Excel.Application”)
    VIEW_XML = objExcel.GetSaveAsFilename(“”, “viewファイル,*.view”)
    objExcel.Quit
    Set objExcel = Nothing
    If VIEW_XML = False Then
    MsgBox “キャンセルしました。”
    Wscript.Quit
    End If

    Set olkApp = CreateObject(“Outlook.Application”)
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    Set curView = olkApp.ActiveExplorer.CurrentFolder.CurrentView
    strXml = curView.XML
    Set stmXml = objFSO.CreateTextFile(VIEW_XML)
    ‘ 1 行目はビューの名前と種類
    stmXml.WriteLine curView.Name & vbTab & curView.ViewType
    stmXml.Write strXml

    ② ビューをファイルにインポート(フォルダ、ファイル名指定版)

    On Error Resume Next
    Dim olkApp
    Dim objFSO
    Dim stmXml
    Dim stmXml2
    Dim strLine
    Dim arrLine
    Dim colViews
    Dim curView
    Dim objVIEW_XML
    With CreateObject(“InternetExplorer.Application”)
    .Visible = False
    .FullScreen = True
    .Navigate “about:blank”

    ‘表示待ち
    While .Busy Or .readyState 4
    WScript.Sleep 100
    Wend

    Set objVIEW_XML = .document.createElement(“input”)
    objVIEW_XML.setAttribute “type”, “file”
    .document.body.appendChild objVIEW_XML
    objVIEW_XML.Click
    If Trim(Len(objVIEW_XML.Value)) > 0 Then
    objVIEW_XML.Focus
    .ExecWB 17, 0 ‘OLECMDID_SELECTALL
    .ExecWB 12, 0 ‘OLECMDID_COPY
    stmXml = CreateObject(“htmlfile”).parentWindow.clipboardData.GetData(“text”)
    End If
    Set objVIEW_XML = Nothing
    .Quit
    End With
    GetFilePathIE2 = stmXml

    Set olkApp = CreateObject(“Outlook.Application”)
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    Set stmXml2 = objFSO.OpenTextFile(stmXml, 1)
    ‘ 1 行目はビューの名前と種類
    strLine = stmXml2.ReadLine
    arrLine = Split(strLine, vbTab)
    Set colViews = olkApp.ActiveExplorer.CurrentFolder.Views
    Set curView = colViews.Add(arrLine(0), arrLine(1), 0)
    If Err.Number = 5 Then ‘ 同名のビューが存在した場合のエラー処理
    For Each curView In colViews
    ‘ 同名のビューを検索
    If curView.Name = arrLine(0) Then
    Exit For
    End If
    Next
    End If
    curView.XML = stmXml2.ReadAll
    curView.Save
    curView.Apply
    stmXml2.Close

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中