既定の予定表の予定を別の予定表にコピーするマクロ


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


Outlook2007で、複数の予定表を使い分けているのですが、事情があってデフォルトの予定表(”予定表”)と別の予定表(”仕事”)を同期したいと思っています。

最初の方針として、デフォルトの予定表をいったんicsファイルで書き出してローカルに保存し、それを予定表(仕事)にインポートするということを考えました。この方法なら、予定のコピーだけでなく、修正された予定の変更もできるはずです。しかし、Outlookでファイルからのインポートを行うと、インポートされた予定はデフォルトの予定表に取り込まれてしまいました。特定の予定表を指定して、そこにicsファイルからインポートすることはできないのでしょうか。また、もしできるのなら、マクロでその作業を行う方法をお教え下さい。なおicsファイルに書き出すマクロはすでにあります。

icsファイル経由が難しければ、デフォルト予定表からアイテムを一つずつコピーするのが次善の方針と思います。それぞれのフォルダを取得するコードは、Outlookのヘルプ等からなんとか見つけたのですが、アイテムをコピーするコードが分かりません。お教えいただけますとありがたく思います。望ましくは、単なるコピーではなく同期(予定の削除や変更も反映)できるとよいのですが、これは無理なのでしょうか。


Outlook 2007 で ics ファイルを開く場合、デフォルトの予定表以外にコピーすることはできないようです。

ただ、予定表のデータをコピーするなら ics ファイルを経由するのではなく、直接コピーするほうが手間がかからないでしょう。

以下は予定表のアイテムをその直下の「仕事」というフォルダーにコピーするマクロです。コピーの際には「既定の予定表からコピー」という分類項目を設定しており、コピー前にあらかじめ以前コピーしたデータを削除する動作にしています。 これなら、結果として変更や削除も同期できます。(仕事のフォルダーで変更したデータは失われますが…)

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub SyncCalendar()
    Const SYNC_CATEGORY = "既定の予定表からコピー"
    Dim calSrc As Folder
    Dim calDst As Folder
    Dim fldDeleted As Folder
    Dim colAppt As Items
    Dim apptSrc As AppointmentItem
    Dim apptDst As AppointmentItem
    Dim i As Integer
    ' 既定の予定表とその下の仕事という名前のフォルダーを取得
    Set calSrc = Session.GetDefaultFolder(olFolderCalendar)
    Set calDst = calSrc.Folders("仕事")
    ' コピー先のフォルダーから以前コピーしたアイテムを削除
    Set colAppt = calDst.Items.Restrict("[分類項目]='" & SYNC_CATEGORY & "'")
    For i = colAppt.Count To 1 Step -1
        colAppt.Item(i).Delete
    Next
    ' 削除済みに残ったアイテムを完全削除
    Set fldDeleted = Session.GetDefaultFolder(olFolderDeletedItems)
    Set colAppt = fldDeleted.Items.Restrict("[分類項目]='" & SYNC_CATEGORY & "'")
    For i = colAppt.Count To 1 Step -1
        colAppt.Item(i).Delete
    Next
    ' アイテムをコピー
    For Each apptSrc In calSrc.Items
        Set apptDst = apptSrc.CopyTo(calDst, olCreateAppointment)
        apptDst.Categories = SYNC_CATEGORY
        apptDst.Save
    Next
End Sub

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

広告

既定の予定表の予定を別の予定表にコピーするマクロ」への3件のフィードバック

  1. 要望した者です。ありがとうございました。

    このマクロでばっちりでした―と書きたかったのですが、私の現在の環境であるGoogle Apps(Google SyncでGoogleとOUTLOOKを同期したもの)では、予定表間のコピーができない仕様のようです。最後の「アイテムをコピー」のところで、「そのプロパティまたはメソッドはサポートされていません」というエラーになってしまいました。Exchangeベースでないと、予定表間のコピーはできないようです。

  2. 予定表間では、以下のようにするとコピーできました。ただし、アイテム名に「コピー:」が付きます。
    Set apptDst = apptSrc.Copy
    apptDst.Categories = SYNC_CATEGORY
    apptDst.Save
    apptDst.Move calDst

  3. お世話になります。

    上記マクロでコピー先を”仕事”では無くiCloudの”予定表”にするにはどうしたら良いのでしょうか。
    恐らく「Set calSrc = Session.GetDefaultFolder(olFolderCalendar)」と次の行を編集すれば良いと思うのですが、上手く動きません。

    初歩的な話で申し訳ありませんが、宜しくお教え下さい。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中