首页 > 解决方案 > 在 MS Access 中使用 VBA 将约会添加到其他人共享的 Outlook 日历

问题描述

我很难将约会添加到他们与我共享的同事日历中。问题似乎出在日历参考中。我的约会不断添加到他们的主要默认日历中,而我试图将它们添加到名为“学习计划”的单独共享日历中。我正在运行 Office 365。

    Dim olApp                 As Outlook.Application
    Dim olappt                As Outlook.AppointmentItem
    Dim bAppOpened            As Boolean
    Dim myNamespace           As Outlook.NameSpace
    Dim objRecip              As Outlook.Recipient
    Dim strName               As String
    Dim myFolder              As Outlook.Folder
 

    Const olAppointmentItem = 1
            
            On Error Resume Next
            Set olApp = GetObject(, "Outlook.Application")
            If Err.Number <> 0 Then
            Err.Clear
            Set olApp = CreateObject("Outlook.Application")
            bAppOpened = False  ' Outlook was not already running, started it
            Else
                bAppOpened = True   ' Outlook was already running
            End If
           ' On Error GoTo Error_Handler
            
            ' Get Study Schedule Folder Location
            Set myNamespace = olApp.GetNamespace("MAPI")
            Set objRecip = myNamespace.CreateRecipient("John Doe")
                objRecip.Resolve
    ' I believe the problem is in the two lines of code below as I try to reference non default folder (shared from john doe)            
                Set myFolder = myNamespace.GetSharedDefaultFolder(objRecip, olFolderCalendar)
                Set myFolder = myFolder.Folders("Study Schedule") 
                myFolder.Display
                Set olappt = myFolder.Items.Add
                'Set olappt = myNewFolder.Items.Add
                With olappt
                            .AllDayEvent = True
                            .Start = ScheduledDate
                            .Subject = StudyName
                            .Body = "Study has been scheduled." & vbCr & _
                                vbCr & _
                                "Calendar Assigned: " & myFolder & vbCr & _
                                "Schedule Entry ID: " & ScheduleEntryID & vbCr & _
                                "Study Name: " & StudyName & vbCr & _
                                "Scheduled Date: " & ScheduledDate & vbCr & _
                                vbCr & _
                                "Principle Investigator: " & PrincipleInvestigator & vbCr & _
                                "Order Placed By: " & OrderPlacedBy & vbCr & _
                                vbCr & _
                                "Species: " & Spec

ies & vbCr & _
                            "Strain: " & Strain & vbCr & _
                            "Sex " & Sex & vbCr & _
                            "Age: " & Age & vbCr & _
                            "Weight: " & Weight & " Kg" & vbCr & _
                            "Quantity : " & Quantity & vbCr & _
                            vbCr & _
                            "Study Information: " & StudyDescription & vbCr & _
                            vbCr & _
                            "This Event was auto generated from the Scheduling Assistant and In-Vivo Database."
                        .Location = ""
                        .Display
               '         .Save
                   '    .Send
            End With

    ... Rest of Code

任何帮助是极大的赞赏!

标签: vbams-accessoutlook

解决方案


共享日历可能与默认日历处于同一级别。

' For a folder at the same level as the default calendar
'  navigate up then back down
Set myFolder = myNamespace.GetSharedDefaultFolder(objRecip, olFolderCalendar)
Set myFolder = myFolder.Parent.Folders("Study Schedule")

推荐阅读