指定した日付以降に更新された送受信メールや連絡先を PST にエクスポート/インポートするマクロ


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


いつも参考にさせて頂き、
要望にも対応頂きありがとうございます

Outlook365
Windows10(64bit)

2台の端末で1つのアカウントでログイン(設定)し
1週間の内、端末Aと端末Bを使用します。

例えば、月曜に端末Aで送受信等ををし、
残りの火曜~金曜は端末Bで送受信等とする場合

送受信メール、連絡先(追加などした場合)の
各データを同期させたいのです。
過去の相当古いデータも残しておきたいため
IMAP等では無理だと判断しています。

単純にデータ(pst)のエクスポートとインポートを
日時指定(作成日時、更新日時)で対応しようと考えています。
マクロ作成可能でしょうか?

日時指定(作成日時、更新日時)はダイアログで指定ができると有難いです。

メールの受信トレイ(階層1として)や送信トレイの下層に
サブフォルダを階層3迄で作成しています。
送受信後、返信や解答があったものは手動で移動しています。

サブフォルダを追加した場合もそのフォルダ等も
エクスポートとインポートの対象になりますよね?

よろしくお願いします。

—-

お返事ありがとうございます。

>Outlook のインポート、エクスポートの機能をマクロで呼び出すことはできないため、マクロ
>ですべて実装する必要があります。
≫≫
以前CSVのエクスポートするマクロを参考にさせて頂きましたが
単純にデータ(pst)のエクスポートとインポートを
日時指定(作成日時、更新日時)で対応はできないでしょうか?

>インポート先に同じアイテムがあった場合に単純な上書きとするのかや、
>そもそも同じアイテムと判断する基準はどうするかなどを考慮する必要があります。
≫≫
手動でデータ(pst)のエクスポートとインポートの時の
ダイアログの条件(下記3種)
・重複した場合、インポートするアイテムと置き換える(E)
・重複してもインポートする(A)
・重複したらインポートしない(D)

このうちの
・重複してもインポートする(A)で良いと考えています。

Outlook 365 を使われているというのは、Office 365 の Outlook を使われているということなのでしょうか?
≫≫
はいそうです。
MicrosoftR OutlookR for Office 365 MSO (16.0.12228.20100) 32 ビット  です。

その場合、サーバーは Exchange を使用しているはずで、連絡先などの情報もメールボックスに保存されているので、PST で同期する必要はないはずです。
≫≫
アプリ自体はOffice 365 の Outlookですが
エクスポートしたいアカウント(主にメール)の種類は
POP/SMTP(送信で使用する既定のアカウント)となっています。
もうひとつ 予定表の管理用として
利用している@outlook.comのアカウントは 種類はMicrosoft Exchangeとなっています。


アイテムのエクスポートやインポートの際に「重複してもインポートする」で構わないということであれば、単純にフォルダーのアイテムをコピーするというようなマクロとなります。
ただし、サブ フォルダーもコピーするとなると、エクスポート先にそのフォルダーがないという可能性もあるため、フォルダーがなければ作成するというロジックが必要になります。
また、日付の指定については InputBox で入力を行い、その日付でフィルターを作成して Items コレクションの Restrict メソッドにより日付の絞り込みを行います。
マクロは以下の通りになります。
なお、エクスポート、インポートする PST ファイルはあらかじめプロファイルに追加して置き、その名前を GetPSTRoot 内の PST_NAME で指定してください。

' ここをトリプルクリックでマクロ全体を選択できます。
'
' PST にエクスポートするプロシージャ
Public Sub ExportToPST()
     Dim fldSrc As Folder
     Dim fldDst As Folder
     Dim strFilter As String
     ' コピー元はメールボックス
     Set fldSrc = Session.DefaultStore.GetRootFolder
     ' コピー先は PST
     Set fldDst = GetPSTRoot()
     If fldDst Is Nothing Then Exit Sub
     ' フィルターを初期化
     strFilter = ""
     ' コピー処理をフォルダーごとに呼び出し
     CopyItems fldSrc, fldDst, "受信トレイ", strFilter
     CopyItems fldSrc, fldDst, "送信トレイ", strFilter
     CopyItems fldSrc, fldDst, "送信済みアイテム", strFilter
     CopyItems fldSrc, fldDst, "下書き", strFilter
     CopyItems fldSrc, fldDst, "連絡先", strFilter
End Sub
'
' PST からインポートするプロシージャ
Public Sub ImportFromPST()
     Dim fldSrc As Folder
     Dim fldDst As Folder
     Dim strFilter As String
     ' コピー元は PST
     Set fldSrc = GetPSTRoot()
     ' コピー先はメールボックス
     Set fldDst = Session.DefaultStore.GetRootFolder
     If fldDst Is Nothing Then Exit Sub
     ' フィルターを初期化
     strFilter = ""
     ' コピー処理をフォルダーごとに呼び出し
     CopyItems fldSrc, fldDst, "受信トレイ", strFilter
     CopyItems fldSrc, fldDst, "送信トレイ", strFilter
     CopyItems fldSrc, fldDst, "送信済みアイテム", strFilter
     CopyItems fldSrc, fldDst, "下書き", strFilter
     CopyItems fldSrc, fldDst, "連絡先", strFilter
End Sub
'
' PST のルートフォルダーを取得する関数
Private Function GetPSTRoot() As Folder
     Const PST_NAME = "個人用 Outlook データ ファイル"
     Dim fldRoot As Folder
     ' プロファイル
     For Each fldRoot In Session.Folders
         If fldRoot.Name = PST_NAME Then
             Set GetPSTRoot = fldRoot
             Exit Function
         End If
     Next
     MsgBox PST_NAME & "が見つかりません。", vbCritical
     Set GetPSTRoot = Nothing
End Function
'
' フォルダごとにアイテムをコピーするプロシージャ
Private Sub CopyItems(fldSrcRoot As Folder, fldDstRoot As Folder, strName As String, strFilter As String)
     On Error Resume Next
     Const PR_ATTR_HIDDEN = "http:" & "//schemas.microsoft.com/mapi/proptag/0x10F4000B"
     Dim fldSrc As Folder
     Dim dfType As OlDefaultFolders
     Dim fldDst As Folder
     Dim colItems As Items
     Dim objItem As Object
     Dim objCopy As Object
     Dim fldSub As Folder
     ' フィルターが設定されていなければ基準日を入力してフィルターを作成
     If strFilter = "" Then
         Dim strDate As String
         strDate = FormatDateTime(CDate(InputBox("基準日")), vbShortDate)
         ' 更新日時が基準日以降であるアイテムを取得するフィルター
         strFilter = "[更新日時] >= '" & strDate & "'"
         ' 作成日時が基準日以降であるアイテムを取得する場合は以下のフィルターを使用
         'strFilter = "[作成日時] >= '" & strDate & "'"
     End If
     ' コピー元フォルダーの取得
     Set fldSrc = fldSrcRoot.Folders(strName)
     ' コピー元フォルダーが隠しフォルダーならコピーせず終了
     If fldSrc.PropertyAccessor.GetProperty(PR_ATTR_HIDDEN) = True Then
         Exit Sub
     End If
     ' コピー先フォルダーの取得
     Set fldDst = fldDstRoot.Folders(strName)
     ' コピー先フォルダーが見つからなければ作成
     If fldDst Is Nothing Then
         ' フォルダーに格納されるアイテムの種別からフォルダー種別を設定
         dfType = GetFolderType(fldSrc)
         ' 新規にフォルダーを作成
         Set fldDst = fldDstRoot.Folders.Add(strName, dfType)
     End If
     ' フィルターによりアイテムを抽出
     Set colItems = fldSrc.Items.Restrict(strFilter)
     ' 抽出したアイテムのすべてについて処理
     For Each objItem In colItems
         ' アイテムのコピーを作成
         Set objCopy = objItem.Copy
         ' アイテムのコピーをコピー先フォルダーに移動
         objCopy.Move fldDst
     Next
     ' サブフォルダーについてもコピー処理
     For Each fldSub In fldSrc.Folders
         CopyItems fldSrc, fldDst, fldSub.Name, strFilter
     Next
End Sub
'
' フォルダーに保存するアイテム種別をもとにフォルダー種別を返す関数
Private Function GetFolderType(fldToCheck As Folder) As OlDefaultFolders
     Select Case fldToCheck.DefaultItemType
         Case olMailItem
             GetFolderType = olFolderInbox
         Case olAppointmentItem
             GetFolderType = olFolderCalendar
         Case olContactItem
             GetFolderType = olFolderContacts
         Case olTaskItem
             GetFolderType = olFolderTasks
         Case Else
             GetFolderType = olFolderInbox
     End Select
End Function

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

指定した日付以降に更新された送受信メールや連絡先を PST にエクスポート/インポートするマクロ」への5件のフィードバック

  1. 早速のマクロ作成ありがとうございます。
    早速試してみました。

    エクスポート、インポートする PST ファイルはあらかじめプロファイルに追加して置き
    その名前を GetPSTRoot 内の PST_NAME で指定してください。
    とのことですが

    手動でエクスポート、インポートする時に指定する PST ファイルと同様に
    例えば…下記のような、任意の場所を指定すればよいのでしょうか?
    ※ユーザー名はPCのユーザー名を入力しています。

    C:\Outlook_CSV\aaa.pst
    D:\ユーザー名\Documents\●PDF\aaa.pst
    Const PST_NAME = “個人用 Outlook データ ファイル”

    一旦手動でエクスポートしaaa.pstを作成し
    “個人用 Outlook データ ファイル”の部分を
    Const PST_NAME = “C:\Outlook_CSV\aaa.pst”
    Const PST_NAME = “D:\ユーザー名\Documents\●PDF\aaa.pst”
    上記のようにいずれに設定しても
    エクスポートでは
    “が見つかりません。”のダイアログが発生しOKで消えてしまいます。
    インポートでは
    “が見つかりません。”のダイアログが発生しOK後、基準日指定のダイアログが表示されます

    それとも、
    エクスポートしたい アカウントのデータファイルが保存されている場所
    D:\ユーザー名\Documents\OutlookData\Outlook.pst
    こちらを下記のように指定でしょうか?

    Const PST_NAME = “D:\ユーザー名\Documents\OutlookData\Outlook.pst”

    こちらを指定しても
    “が見つかりません。”のダイアログが発生します。

    また、基準日指定は2019/12/23というスラッシュの入った式で指定でよいのでしょうか?

    よろしくお願いいたします。

    • PST_NAME にはメッセージ一覧のウィンドウの左のフォルダー一覧に表示される PST のルートのフォルダー名です。
      PST のファイル名で aaa.pst と指定した場合は、PST_NAME は “aaa” になるはずです。
      また、日付の指定は 2019/12/23 というようなもので問題ありません。

  2. 度々、申し訳ございません。

    ※下記文中の aaa bbb は伏字です。

    メッセージ一覧のウィンドウの左のフォルダー一覧に表示される PST のルートのフォルダー名とのことですが
    メッセージ一覧のウィンドウの左のフォルダー一覧 とは
    Outlookで受信トレイ等を開いている時の左のフォルダーウインドウの事ですよね?

    aaa@bbb-co.com です

    aaa@bbb-co.comを 電子メールアカウントで確認するとデータファイルは下記となっています。
    データ ファイル: D:\aaa\Documents\OutlookData\Outlook.pst

    Const PST_NAME = “個人用 Outlook データ ファイル”

    Const PST_NAME = “aaa@bbb-co.com”

    と指定し Public Sub ExportToPST() を実行しましたら
    見つかりませんはでず、基準日のダイアログが出ました。
    先週末の日付 2020/01/17 と入力してみましたが
    特段変化はないです。
    [更新日時]や[作成日時]の選択のダイアログは出ません。

    あと、エクスポートされたデータはどこに保存(作成)されるのでしょうか?

    もしかして?
    データ ファイル: D:\aaa\Documents\OutlookData\Outlook.pstの

    Const PST_NAME = “Outlook”
    とすると Outlookは見つかりませんとメッセージがでました。

    よろしくお願いいたします。

    • PST_NAME で指定する必要があるのは、「メールを受信した PST」ではなく、エクスポートしたメールを別の PC で参照するためにコピーして使う PST のことです。
      コピー用の PST を新規作成すると、左のフォルダー一覧のトップにはメールアドレスとは別に、新規作成した PST の名前が表示されているはずです。
      その名前を PST_NAME に追加するということになります。

  3. コピー用の PST を新規作成とは
    ファイル→アカウント設定→メールで新規作成ということでしょうか?

    2台の端末で1つのアカウントでログイン(設定)し
    1週間の内、端末Aと端末Bを使用しています。
    両端末には同じアカウント設定済み

    今回のマクロを実行するには各端末で通常使用しているアカウントとは別のアカウントを
    エクスポート用に作成する必要があるということでしょうか?

    マクロでないエクスポートの手順でエクスポートファイル名を指定するように
    任意のフォルダ(ファイル名) 例えば
    C:\Users\s-shiota\Documents\Export.pst 等と指定するという訳には行かないのでしょうか?

    PST_NAME で指定する
    Const PST_NAME = “C:\Users\s-shiota\Documents\Export.pst”

    左のフォルダー一覧には
    メール受信をしている アカウントA a-aaaaaa@aaaaa.com です。
    予定表を入力している アカウントB b-bbbbbb@outlook.com です。
    アカウントAのarchive

    今回のデータをエクスポートインポートしたいのは
    アカウントA a-aaaaaa@aaaaa.com です。

    Const PST_NAME = “a-aaaaaa@aaaaa.com”
    としましたら エラーはでず、基準日を入力する画面となり
    試しに2020/02/10と入力しました。

    特段変化はないです。
    [更新日時]や[作成日時]の選択のダイアログは出ません。

    あと、エクスポートされたデータはどこに保存(作成)されるのでしょうか?

    よろしくお願いいたします。

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中