iCloudカレンダーから予定表に予定をコピーするマクロ

Question

Windows 7でOutlook 2007を使用しています。最近iCloudをインストールしましたが、残念ながらGoogleカレンダー同期では既定の予定表が同期されるだけです。誰かが多くのだろう

1. 空のすべての予定
2. コピーのデフォルトのカレンダーのデフォルトのカレンダーへのiCloudカレンダーからすべての予定

簡単なVBAマクロで私を助けることができる場合、私は思っていましたありがとう！この回答で

Answer 1

健康警告

すべてが実験によって発見されました。私はVB Helpから始めて、F2を使ってオブジェクトモデルにアクセスし、何がうまくいくかを見つけるまで実験しました。私は非常に推薦された参考書を購入しましたが、それは私が発見しなかった重要なものを何も含んでいませんでした。

私が得た知識の重要な特徴は、それが多くの異なるインストールに基づいていることです。遭遇した問題のいくつかは、インストールの間違いの結果であり、なぜ参考書の作者がそれらを知らなかったのかを説明しているかもしれない。

次のコードは、私はあなたが最初のバージョンとの報告

イミディエイトウィンドウに、デフォルトのカレンダー内の予定のプロパティを選択見通し2007

出力と類似したコードをテストしている展望2003でテストされていますこのルーチンのエラー： "ランタイムエラー '-2147467259（80004005）'：正の期間を入力する必要があります。

私がGoogleで見つけたウェブサイトによると、エラー80004005はシステムファイルが壊れていることを意味します。

アポイントには、Start（日付の入力）、End（タイプの日付）、Duration（タイプLong）の3つの関連項目があります。私は、EndまたはDurationが実行時に導出されると仮定します。私の推測では、Durationが負であるか、StartがStartの前にあるということです。私は私のシステム上でこのマクロによって作成された予定のリストで、終日イベントのいくつかがプロパティAllDayEvent = Falseを持つことに気付きました。アポイントメントを作成し、後でAllDayEventをオンまたはオフに切り替えると矛盾が生じていたことがわかりました。

この問題を検出しようとするコードを追加しましたが、私のシステムでこのエラーが発生する予定がないため、テストできません。このマクロは、あなたの現在の予定のリストから始めることを目的としていましたので、それを働かせることができない場合は、あまり心配しないでください。

Sub ReviewCalendar() 

    Dim DateTimeEnd As Date 
    Dim DateTimeStart As Date 
    Dim Duration As Long 
    Dim ItemMine As Object 
    Dim ItemMineClass As Long 
    Dim FolderTgt As MAPIFolder 

    Set FolderTgt = CreateObject("Outlook.Application"). _ 
        GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar) 

    ' I use this macro to list selected properties from the test calendar. 
    ' Add a quote to the statement above and remove the quote from the next 
    ' statement to do the same. 
    'Set FolderTgt = CreateObject("Outlook.Application"). _ 
        GetNamespace("MAPI").Folders("Test Folders"). _ 
        Folders("Calendar") 

    For Each ItemMine In FolderTgt.Items 

    With ItemMine 

     ' Occasionally I get syncronisation 
     ' errors. This code avoids them. 
     ItemMineClass = 0 
     On Error Resume Next 
     ItemMineClass = .Class 
     On Error GoTo 0 

     If ItemMineClass = olAppointment Then 
     Debug.Print "** Subject: " & .Subject 
     Debug.Print " Created: " & _ 
         Format(.CreationTime, "d mmm yy hh:mm:ss") 
     Debug.Print " Updated: " & _ 
         Format(.LastModificationTime, "d mmm yy hh:mm:ss") 
     Debug.Print " Time: "; 
     DateTimeStart = .Start 
     If .AllDayEvent Then 
      Debug.Print "All day " & Format(.Start, "d mmm yy") 
     Else 
      On Error Resume Next 
      DateTimeEnd = .End 
      Duration = .Duration 
      On Error GoTo 0 
      If Duration <= 0 Then 
      Debug.Print " ##### Invalid duration #####" 
      End If 
      Debug.Print Format(.Start, "h:mm") & " to " & _ 
         Format(.End, "h:mm") & "(" & .Duration & _ 
         " minutes) on " & Format(.Start, "d mmm yy") 
     End If 
     ' If you remove the quote from the following statement 
     ' it will delete the appointment. 
     ' .Delete  ' Delete appointment 
     End If 
    End With 
    Next 

End Sub 

予定

のコピーをテストするための準備、私はあなたが重要なものに影響を与えずにマクロをテストできるように、テスト用フォルダを作成することをおすすめします。

1. ツールバーから、[ファイル]、[新規作成]、[Outlookデータファイル]、[Office Outlook個人用フォルダファイル（.pst）]を選択します。
2. 既存のPSTファイルの一覧が表示されたウィンドウが表示されます。私のシステムでは、archive.pst、Outlookです。pstとTest.pst。
3. 下部にデフォルトのファイル名が選択されています。 "Test"または他の名前を入力してください。
4. 別のウィンドウが表示されるので、（1）Outlookエクスプローラウィンドウで新しい個人用フォルダの名前を選択し、（2）暗号化のレベルを選択できます。 "Test"または他の名前を入力してください。 （Outlookはあなたの名前に "Folders"を追加します）私は自分のシステム上でメッセージを暗号化または保護しませんが、それはあなたの選択です。
5. ツールバーから、[実行]、[フォルダー一覧]を選択します。フォルダエクスプローラウィンドウの代わりにフォルダリストが表示されます。
6. フォルダ「カレンダー」を右クリックし、「新規フォルダ」を選択します。 [新しいフォルダ]ウィンドウが表示されます。
7. 「カレンダー」として名前を入力し、フォルダとして「テストフォルダ」を選択します。

ここで、[カレンダー]を選択すると、「テストフォルダのカレンダー」が追加選択肢として表示されます。テストカレンダーにデフォルトのカレンダーから

コピーの予定

このマクロは、デフォルトのカレンダー内のすべての予定のテストの予定表にコピーを作成します。
一度実行してから[Calandar]を選択し、デフォルトとテストカレンダーの両方にチェックマークを付けます。 2つのカレンダーは同一である必要があります。

警告：マクロを再度実行すると、各予定の2つのコピーが終了します。

Sub CopyCalendar() 

    Dim FolderDest As MAPIFolder 
    Dim ItemCopy As AppointmentItem 
    Dim ItemMine As Object 
    Dim ItemMineClass As Long 
    Dim NameSpaceMine As NameSpace 
    Dim FolderSrc As MAPIFolder 

    Set NameSpaceMine = _ 
      CreateObject("Outlook.Application").GetNamespace("MAPI") 

    With NameSpaceMine 
    Set FolderSrc = .GetDefaultFolder(olFolderCalendar) 
    Set FolderDest = .Folders("Test Folders").Folders("Calendar") 
    End With 

    Debug.Print FolderSrc.Items.Count 
    Debug.Print FolderDest.Items.Count 

    For Each ItemMine In FolderSrc.Items 

    With ItemMine 

     ' Occasionally I get syncronisation 
     ' errors. This code avoids them. 
     ItemMineClass = 0 
     On Error Resume Next 
     ItemMineClass = .Class 
     On Error GoTo 0 

     ' I have never found anything but appointments in 
     ' Calendar but test just in case 
     If ItemMineClass = olAppointment Then 
     Set ItemCopy = .Copy 
     ItemCopy.Move FolderDest 
     End If 

    End With 

    Next 

End Sub 

次は

Set FolderDest文はその階層を下に働くことによってpartcularフォルダを選択する方法を示して繰り返します。他のより一般的な手法がありますが、この方法でiCloundカレンダーにアクセスできる場合は、これで十分です。

Set NameSpaceMine = _ 
      CreateObject("Outlook.Application").GetNamespace("MAPI") 

    With NameSpaceMine 
    Set FolderDest = .Folders("Test Folders").Folders("Calendar") 
    End With 

最初のマクロは、カレンダ内のすべての予定と別のカレンダーから第二のコピーの予定を削除するためのコードを含みます。

このコードを組み合わせて適用すると、一方向の同期が得られます。つまり、カレンダー2にカレンダー1のコピーが作成されます。これは適切ですか？ iCloudカレンダーをデフォルトのカレンダーで上書きするのは適切でしょうか？双方向同期はより複雑です。私はいくつかの "エンタープライズ"同期ルーチンを経​​験していますが、誰もばかではありません。あなたが「企業が高価で品質の低いソフトウェアを超えているということ」の場合、あなたは驚かないでしょう。そうしないと、双方向の同期が困難であるか、または両方のステートメントが真であることに同意することができます。

問題は、次のとおりのいずれかのカレンダーに

1. 非識別プロパティが変更されてもよいです。
2. いずれかの予定表に予定を追加したり削除したりすることができます。
3. いずれかのカレンダーのプロパティを変更することができます。典型的には、被験者および/または開始時間は特性を特定することであるが、被験者を変更して、その予定を移動させることができる。

私のシステムでは、CreationTimeとLastModificationTimeは変更されずにコピーされるので、識別子として使用するというオプションがあります。私は、会議の要求のために更新されているカレンダーのCreationTimeとLastModificationTimeへの影響をテストする方法がありません。

私はあなたにこれらの問題を考慮し、この問題をどのように進めたいかを決定します。