Предупреждение о вреде для здоровья
Все в этом ответе было обнаружено экспериментально.Я начал с VB Help, использовал F2 для доступа к объектной модели и экспериментировал, пока не нашел то, что сработало.Я купил очень рекомендуемый справочник, но в нем не было ничего важного, чего я не обнаружил, и многое из того, что я обнаружил, опущено.
Я подозреваю, что ключевой особенностью полученных мной знаний является то, что они основаны на многихразные установки.Некоторые из возникших проблем могли быть результатом ошибок установки, которые объясняли бы, почему авторы справочника не знали о них.
Приведенный ниже код был протестирован с Outlook 2003. Я тестировал похожий код с Outlook 2007.
Вывод выбранных свойств встреч в пределах стандартного окна «Календарь» в окно «Немедленно»
Вы сообщили, что в первой версии этой подпрограммы выдана ошибка: «Ошибка времени выполнения» -2147467259 (80004005) ': Вы должны ввести положительную продолжительность. "
Согласно веб-сайтам, которые я нашел в Google, ошибка 80004005 означает, что системный файл поврежден.
У встречи есть три связанных элемента: Начало(введите Date), End (введите Date) и Duration (введите Long).Я предполагаю, что либо End, либо Duration получаются во время выполнения.Я предполагаю, что либо Длительность отрицательна, либо Конец перед началом.В списке встреч, созданных этим макросом в моей системе, я заметил, что некоторые события на весь день имеют свойство 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
Подготовка к тестированию копирования встреч
Я предлагаю вам создать тестовую папку, чтобы вы могли тестировать макросы, не выполняя ничего важного.
- На панели инструментов выберите «Файл», «Создать», «Файл данных Outlook», «Файл личных папок Office Outlook» (.pst).
- Появится окно со списком существующих файлов PST.В моей системе это: archive.pst, Outlook.pst и Test.pst.
- Внизу выбрано имя файла по умолчанию.Введите «Тест» или другое имя по вашему выбору.
- Появляется другое окно, в котором вы можете (1) выбрать имя, используемое для новой личной папки в окне Outlook Explorer, и (2) выбрать уровень шифрования.Введите «Тест» или другое имя по вашему выбору.(Outlook добавит «Папки» к вашему имени.) Я не шифрую и не защищаю паролем сообщения в моей системе, но это выбор для вас.
- На панели инструментов выберите Перейти, Список папок.Вместо окна проводника вывода появится список папок.
- Щелкните правой кнопкой мыши папку «Календарь» и выберите «Новая папка».Откроется окно «Новая папка».
- Введите имя как «Календарь» и выберите «Тестовые папки» в качестве его местоположения.
Теперь, когда вы выберете «Календарь», вам будет предложено «Календарь в«Папки для тестирования» в качестве дополнительного выбора.
Копировать встречи из Календаря по умолчанию в Календарь тестирования
Этот макрос создает копию в Календаре испытаний для каждой встречи в Календаре по умолчанию.
Запустите его один раз, затем выберите 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 показывает, как выбрать отдельную папку, работая по ее иерархии.Существуют и другие, более общие методы, но этого должно быть достаточно для ваших требований, если вы можете получить доступ к Календарю iClound таким образом.
Set NameSpaceMine = _
CreateObject("Outlook.Application").GetNamespace("MAPI")
With NameSpaceMine
Set FolderDest = .Folders("Test Folders").Folders("Calendar")
End With
Первый макрос содержит код для удаления каждой встречи в календаре, а второй копирует встречи из одного календаря в другой.
Комбинирование и адаптация этого кода даст вам одностороннюю синхронизацию. То есть, это сделало бы Календарь 2 копией Календаря 1. Это адекватно? Будет ли достаточно перезаписать Календарь iCloud с Календарем по умолчанию? Двусторонняя синхронизация более сложна. Я испытал несколько «корпоративных» процедур синхронизации, и ни одна не была надежной. Если вы учитесь в школе «предприятие означает слишком дорогое и некачественное программное обеспечение», вы не удивитесь. В противном случае вы можете согласиться с тем, что двусторонняя синхронизация затруднена или оба утверждения верны.
Проблемы:
- Неидентифицируемые свойства в любом календаре могут быть изменены.
- Встречу можно добавить или удалить из любого календаря.
- Идентификационные свойства в любом календаре могут быть изменены. Обычно субъект и / или время начала определяют свойства, но объект может быть изменен, и назначение может быть перемещено.
В моей системе CreationTime и LastModificationTime копируются без изменений, поэтому существуют варианты использования их в качестве идентификаторов. У меня нет средств для проверки влияния на CreationTime и LastModificationTime календаря, обновляемого из-за приглашения на собрание.
Я оставляю вас рассмотреть эти вопросы и решить, как вы хотите продвигать этот вопрос вперед.