Устранение неполадок с общей папкой календаря не по умолчанию

Question

Я пытаюсь обновить общий календарь с листа excel. Код, который у меня работает, отлично подходит для владельца этого общего календаря, но он не подходит для меня. Календарь был открыт для меня, и у меня есть полные права владельца.

Я могу редактировать календарь вручную без проблем, но идея состоит в том, что каждый сможет запустить макрос с этого листа excel для обновления общего календаря. Вот соответствующий код, только до точки сбоя:

Sub UpdateSched() 

Dim olApp As Outlook.Application 
Dim olNameSpace As Outlook.Namespace 
Dim olFolder As Outlook.MAPIFolder 
Dim olFldrOwner As Outlook.Recipient 

On Error Resume Next 
' check if Outlook is running 
Set olApp = GetObject("Outlook.Application") 
If Err <> 0 Then 
    'if not running, start it 
    Set olApp = CreateObject("Outlook.Application") 
End If 
On Error GoTo 0 

Set olNameSpace = olApp.GetNamespace("MAPI") 
Set olFldrOwner = olNameSpace.CreateRecipient("ownrAlias") 
    olFldrOwner.Resolve 

Set olFolder = Nothing 

If olFldrOwner.Resolved Then 
    Set olFolder = olNameSpace.GetSharedDefaultFolder(olFldrOwner, olFolderCalendar) 

' If olFolder Is Nothing Then 
'  Debug.Print "Nothing" 
' Else 
'  Debug.Print olFolder.Name '<-Error here if the if-block is run 
' End If 

    '****************************** 
    Set olFolder = olFolder.Folders("Transport Sched") '<-Object Not Found Error 
    '****************************** 
End If 

'Code below updates appointments on the shared calendar 

Полная ошибка «не удалось Предпринятая операция. Объект не найден. '

Для тестирования я добавил закомментированный блок. Это заставило меня подумать, что ошибка может быть в предыдущей строке. Когда этот блок не комментируется, ошибки кода выходят из строки после Else (та же ошибка). Таким образом, объект olFolder не является ничем, но его невозможно найти.

Снова все это прекрасно работает, когда владелец этого календаря запускает его. Для меня это «Общие календаря», и я получаю ошибки. Он также отлично работает, если я использую тот же код для обновления созданного мной календаря, который находится в разделе «Мои календари».

Это проблема с поиском правильной папки для общего календаря, не так ли? Путь к папке не должен меняться, поэтому я мог бы жестко закодировать его, чтобы он работал для всех, возможно ли это?

Answer 1

Я придумал решение своей проблемы, но совершенно иначе, чем пытался с кодом, указанным в вопросе. В случае, если кто-то нуждается в этом, вот решение:

Sub ListCalendars() 
Dim olApp As Outlook.Application 
Dim olPane As Outlook.NavigationPane 
Dim olModule As Outlook.CalendarModule 
Dim olGroup As Outlook.NavigationGroup 
Dim olNavFolder As Outlook.NavigationFolder 
Dim olFolder As Folder 
Dim i As Integer, j As Integer 

On Error Resume Next 
' check if Outlook is running 
Set olApp = GetObject("Outlook.Application") 
If Err <> 0 Then 
    'if not running, start it 
    Set olApp = CreateObject("Outlook.Application") 
End If 
On Error GoTo 0 

Set olPane = olApp.ActiveExplorer.NavigationPane 
Set olModule = olPane.Modules.GetNavigationModule(olModuleCalendar) 
Set olGroup = olModule.NavigationGroups.GetDefaultNavigationGroup(olMyFoldersGroup) 

'Dummy Do loop allows exit from within nested For-Next loops 
Do 
For i = 1 To olModule.NavigationGroups.Count  'Cycle through all Nav Groups 
    Set olGroup = olModule.NavigationGroups.Item(i) 
    Debug.Print olGroup.Name 

    For j = 1 To olGroup.NavigationFolders.Count 'Cycle through all calendars in group 
     Set olNavFolder = olGroup.NavigationFolders.Item(j) 
     Debug.Print " - " & olNavFolder.DisplayName 

     'Un-comment If-block below if searching for a particular calendar: 
      'CalendarName is the name of the calendar,as listed in your navigation pane 
'   If olNavFolder.DisplayName = "CalendarName" Then 
'   Debug.Print "Found it!" 
'   Set olFolder = olNavFolder.Folder 'To get folder object from NavigationFolder 
'   Exit Do 
'  End If 

    Next 
Next 
Exit Do 'To prevent endless loop 
Loop While True 

'If-block below displays results if looking for matching calendar name 
'If olFolder Is Nothing Then 
' Debug.Print vbNewLine & "No match found" 
'Else 
' Debug.Print vbNewLine & "Matching calendar found: " & olFolder.Name 
'End If 

End Sub 

Этот код был изменен с this page here. В принципе, доступ к кому-то другому объекту календаря напрямую дал мне проблемы, даже если календарь был общим. Однако, используя различные навигационные объекты, я смог просмотреть все календари, перечисленные в моей навигационной панели, включая все общие календари.

Как предусмотрено в этой подпрограмме, просто перечислены основные папки и один уровень подпапок. Если два if-блока раскоментированы, подпрограмма будет искать календарь с заданным именем (просто замените CalendarName) и покажет, было ли найдено совпадение.

Фиктивный цикл Do был одним из способов выхода из вложенных циклов. Существует несколько других способов сделать это в списке in this SO question.

Еще одна сложная вещь: объекты NavigationFolder не совпадают с объектами папки. Это, казалось бы, несущественные линия:

Set olFolder = olNavFolder.Folder 

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