最後にバックアップした日時以降に受信したメールを PST にバックアップするスクリプト


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


教えてください。Outlook 2016 のメールのエクスポートコマンドを、VBScriptから呼び出して
定期的に受信トレイのメールをPSTファイルをバックアップする方法を知りたいです。

フィルターとして受信日時を直前のバックアップ日時以降として、PSTファイル名は現日時と
することで、重複なしでバックできると、嬉しいです。


残念ながら Outlook のエクスポート機能を Outlook オブジェクト モデルで呼び出すことはできません。

ただ、PST へのバックアップを行うという処理をスクリプトで実装することは可能です。
NameSpace オブジェクトの AddStoreEx メソッドを使うと PST をプロファイルに追加することができます。
そして、追加した PST に「受信トレイ」というフォルダーを作成し、既定の受信トレイのアイテムをコピーすることでバックアップが実現できます。
最後に、追加した PST は RemoveStore でプロファイルから削除できます。
なお、特定の日時以降に受信したメールのみをバックアップするには、Items オブジェクトの Restrict メソッドを使ってフィルタリングを行います。
また、最後にバックアップした日時を保存する方法については、今回のスクリプトでは StorageItem オブジェクトを使用しています。
まとめると、以下のようなスクリプトになります。

' ここをトリプルクリックでスクリプト全体を選択できます。

' バックアップ PST を保存するフォルダーの指定
Const PST_ROOT = "c:\backup\"
Const MSGCLASS_ETP = "IPM.OutlookLab.ExportToPst"
' Outlook の定数指定
Const olStoreDefault = 1
Const olFolderInbox = 6
Const olIdentifyByMessageClass = 2
Dim olkApp 'As Outlook.Application
Dim objSession 'As Namespace
Dim strStartTime 'As String
Dim oneStore 'As Store
Dim strPstName 'As String
Dim fldPst 'As Folder
Dim fldPstInbox 'As Folder
Dim fldInbox 'As Folder
Dim stgItem 'As StorageItem
Dim strLastBackup 'As String
Dim colItems 'As Items
Dim srcItem 'As MailItem
Dim dstItem 'As MailItem
' Outlook オブジェクトの生成
Set olkApp = CreateObject("Outlook.Application")
Set objSession = olkApp.Session
' 現在の日付と時刻を取得
strStartTime = Now
' 現在の日付と時刻により PST ファイルの名前を作成
strPstName = Replace(Replace(Replace(strStartTime, "/", ""), ":", ""), " ", "")
' PST ファイルをプロファイルに追加
objSession.AddStoreEx PST_ROOT & strPstName & ".pst", olStoreDefault
' 追加した PST のルート フォルダーを検索
For Each oneStore In objSession.Stores
     If oneStore.FilePath = PST_ROOT & strPstName & ".pst" Then
         Set fldPst = oneStore.GetRootFolder
         fldPst.Name = "Backup " & strStartTime
         Exit For
     End If
Next
' PST に受信トレイ フォルダーを作成
Set fldPstInbox = fldPst.Folders.Add("受信トレイ")
' 既定の受信トレイを取得
Set fldInbox = objSession.GetDefaultFolder(olFolderInbox)
' バックアップ日時を保存する StorageItem を作成
Set stgItem = fldInbox.GetStorage(MSGCLASS_ETP, olIdentifyByMessageClass)
' StorageItem の件名が最終バックアップ日時
strLastBackup = stgItem.Subject
stgItem.Subject = FormatDateTime(Now, vbShortDate) & " " & FormatDateTime(Now, vbShortTime)
stgItem.Save
' 最終バックアップ日時を確認
If strLastBackup = "" Then
     ' 日時が設定されていなければすべてのアイテムをバックアップ
     Set colItems = fldInbox.Items
Else
     ' 最終バックアップ日時より後に受信したアイテムをフィルタリング
     Set colItems = fldInbox.Items.Restrict("[受信日時] > '" & strLastBackup & "'")
End If
' フィルタリングされたアイテムを PST にコピー
For Each srcItem In colItems
     Set dstItem = srcItem.Copy
     dstItem.Move fldPstInbox
Next
' PST ファイルをプロファイルから切断
objSession.RemoveStore fldPst

最後にバックアップした日時以降に受信したメールを PST にバックアップするスクリプト」への1件のフィードバック

  1. サンプル公開ありがとうございます。とても参考になりました。
    投稿から時間が経っていていて、チェックを漏らしておりすいません。
    自分の環境で確認してみます。

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中