Как добавить назначение в общий календарь в Outlook?

Я пытаюсь написать макрос, который создаст встречу, взятую из файла .CSV с темой и датой, и поместите это в чужой общий календарь. У меня есть полные разрешения редактора для этого общего календаря. По совместному календарю я подразумеваю обычный календарь, сделанный в Outlook человека, и просто щелкаю «Share» и отправляю его по электронной почте другим пользователям.Как добавить назначение в общий календарь в Outlook?

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

Sub ImportAppointments(full_path As String) 

'Initialize variables 
Dim exlApp As Excel.Application 
Dim exlWkb As Workbook 
Dim exlSht As Worksheet 
Dim rng As Range 
Dim itmAppt As Outlook.AppointmentItem 

' Create reference to Excel 
Set exlApp = New Excel.Application 

' Select file path, currently hardcoded to one directory, change as needed 
Dim strFilepath As String 
'strFilepath = "P:\Holiday Calendar\Holiday_Calendar_Data.csv" 
strFilepath = full_path 

' Select workbook (the above .csv file) and select the first worksheet as the data sheet 
Set exlSht = Excel.Application.Workbooks.Open(strFilepath).Worksheets(1) 

' Initialize variables 
Dim iRow As Integer 
Dim iCol As Integer 
Dim oNs As Namespace 
Dim olFldr As Outlook.MAPIFolder 
Dim objOwner As Outlook.Recipient 

' Allow accessing data stored in the user's mail stores in Outlook 
Set oNs = Outlook.GetNamespace("MAPI") 

' Set share calender owner 
Set objOwner = oNs.CreateRecipient("[email protected]") 
    objOwner.Resolve 

If objOwner.Resolved Then 

    ' Set up non-default share folder location 
    Set olFldr = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar).Folders("Holiday Calendar") 

End If 

' Start point 
iRow = 2 
iCol = 1 

' Loop through each calendar entry 
While exlSht.Cells(iRow, 1) <> "" 

    Set itmAppt = Outlook.CreateItem(olAppointmentItem) 

    ' Set appointment Subject, ie (Vacation, Sick Day, Half-Day, etc.) 
    itmAppt.Subject = exlSht.Cells(iRow, 1) 

    ' Set Date of Event 
    itmAppt.Start = exlSht.Cells(iRow, 2) 

    ' Force All Day Event 
    itmAppt.AllDayEvent = True 

    ' Save appointment 
    itmAppt.Save 

    ' Advance pointer to next row 
    iRow = iRow + 1 

    ' Transfer appointment into shared calendar folder 
    itmAppt.Move olFldr 

Wend 

' Close everything 
Excel.Application.Workbooks.Close 
exlApp.Quit 
Set exlApp = Nothing 
Set olFldr = Nothing 
Set itmAppt = Nothing 

End Sub

Мой код не может найти "Holiday Calendar", если я пытаюсь вставить в чужом календаре (Set olFldr = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar).Folders("Holiday Calendar")), но не мой. Пожалуйста, порекомендуйте.

источник

2016-05-20 Calvin P

Вместо того, чтобы звонить Application.CreateItem/AppointmentItem.Move, создайте элемент напрямую, используя olFldr.Items.Add.

источник

2016-05-20 19:38:31

Как добавить назначение в общий календарь в Outlook?

ответ

Смежные вопросы