Outlook 2007 Macro для копирования приложений из календаря iCloud в календарь по умолчанию

Question

Я использую Outlook 2007 для Windows 7. Недавно я установил iCloud, к сожалению, понял, что Google Calendar Sync будет синхронизировать календарь по умолчанию. Мне было интересно, если кто-то может помочь мне с простым VBA макросом, который бы

1. Пустого календарь по умолчанию всех назначений
2. Копирование всех назначений из календаря ICloud в календарь по умолчанию

Многому благодаря!

Answer 1

предупреждение здоровья

Все в этом ответе было обнаружено экспериментально. Я начал с VB Help, использовал F2 для доступа к объектной модели и экспериментировал, пока не нашел, что сработало. Я действительно купил рекомендованный справочник, но в нем не было ничего важного, которого я не обнаружил, и опустил многое, что я обнаружил.

Я подозреваю, что ключевой особенностью знаний, которые я приобрел, является то, что он основан на множестве различных установок. Некоторые из возникших проблем могут быть результатом ошибок установки, которые могли бы объяснить, почему авторы справочных материалов не знали о них.

ниже код был протестирован с Outlook 2003. Я испытал подобный код с Outlook 2007.

Выходные выбраны свойства назначений в рамках календаря по умолчанию в окне Immediate

Вы сообщили, что первая версия этой процедуры дал ошибку: «Ошибка выполнения» -2147467259 (80004005) ': Вы должны ввести положительную продолжительность. "

Согласно сайтам, которые я нашел в Google, ошибка 80004005 означает, что системный файл поврежден.

Назначение имеет три связанных элемента: начало (тип даты), конец (тип даты) и продолжительность (тип длинный). Я предполагаю, что либо End, либо Duration будет получен во время выполнения. Я предполагаю, что либо Duration отрицательный, либо End перед запуском. Я отмечаю в списке назначений, созданных этим макросом в моей системе, что некоторые события в течение всего дня имеют свойство 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. Внизу выбрано имя по умолчанию. Введите «Тест» или другое имя по вашему выбору.
4. Появится другое окно, позволяющее (1) выбрать имя, используемое для новой личной папки в окне Outlook Explorer, и (2) выбрать уровень шифрования. Введите «Тест» или другое имя по вашему выбору. (Outlook добавит «Folders» к вашему имени.) Я не шифрую или защищаю паролем сообщение в своей системе, но это выбор для вас.
5. На панели инструментов выберите «Перейти», «Список папок». Список папок появится вместо окна «Проводник вывода».
6. Щелкните правой кнопкой мыши папку «Календарь», затем выберите «Новая папка». Откроется окно «Новая папка».
7. Введите имя как «Календарь» и выберите «Тестирование папок» в качестве своего местоположения.

Теперь, когда вы выбираете Календарь, вам будет предложен «Календарь в тестовых папках» в качестве дополнительного выбора.

Копирование назначений из календаря по умолчанию, чтобы проверить календарь

Этот макрос создает копию в тестовом календаре каждого назначения в календаре по умолчанию.
Запустите его один раз, затем выберите Calandar и отметьте как календарь по умолчанию, так и тестовый календарь. Два календаря должны быть одинаковыми.

Предупреждение: Если вы снова запустите макрос, вы закончите с двумя копиями каждой встречи.

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 Calendar таким образом.

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

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

Первый макрос содержит код для удаления каждой встречи в календаре и вторых копий встреч из одного календаря в другой.

Объединение и адаптация этого кода даст вам одностороннюю синхронизацию. То есть, это сделает Calendar 2 копией Календаря 1. Это адекватно? Будет ли переписывать календарь iCloud с календарем по умолчанию, достаточным? Двусторонняя синхронизация сложнее. Я испытал несколько «корпоративных» процедур синхронизации, и ни один из них не был безупречным. Если вы используете «предприятие означает более дорогое, плохое качество программного обеспечения», вы не будете удивлены. В противном случае вы можете согласиться с тем, что двухсторонняя синхронизация затруднена или что оба утверждения верны.

Вопросы являются:

1. неидентифицирующей свойства в любом календаре могут быть изменены.
2. Назначение может быть добавлено или удалено из любого календаря.
3. Идентификация свойств в любом календаре может быть изменена. Обычно субъект и время начала определяют свойства, но субъект может быть изменен, и назначение может быть перемещено.

В моей системе CreationTime и LastModificationTime копируются без изменений, поэтому существуют опции, которые используют их как идентификаторы. У меня нет средств для проверки влияния на CreationTime и LastModificationTime календаря, обновляемого из-за запроса на собрание.

Я оставляю вас рассмотреть эти проблемы и решить, как вы хотите продвинуть этот вопрос вперед.