Calendar 将Outlook日历项目从Access 2010添加到公用文件夹

我正在尝试将Access 2010中的日历约会添加到Outlook公共日历中。我已经找到了几种方法来实现这一点，但似乎无法让它与我的代码一起工作。有一个问题可能是，我不明白在设置要保存的文件夹时代码在做什么。这是我保存到Outlook日历的代码。如何将其保存到名为Janetest的公共Outlook日历？请解释一下代码，因为我想这就是我感到困惑的地方。提前谢谢

Private Sub Command60_Click()

 ' Exit the procedure if appointment has been added to Outlook.
 If Me.chkAddedToOutlook = True Then
     MsgBox "This appointment has already added to Microsoft Outlook.", vbCritical
     Exit Sub
 Else

     ' Use late binding to avoid the "Reference" issue
     Dim olApp As Object        'Outlook.Application
     Dim olAppt As Object        'olAppointmentItem
     Dim dteTempEnd As Date
     Dim dteStartDate As Date
     Dim dteEndDate As Date

     If isAppThere("Outlook.Application") = False Then
         ' Outlook is not open, create a new instance
         Set olApp = CreateObject("Outlook.Application")
         Else
         ' Outlook is already open--use this method
         Set olApp = GetObject(, "Outlook.Application")

     End If

    Set olAppt = olApp.CreateItem(1) ' 1 = olAppointmentItem

    With olAppt

         If Nz(Me.AllDay_YesNo) = True Then

             .Alldayevent = True

             ' Get the Start and the End Dates
             dteStartDate = CDate(FormatDateTime(Me.TxtBeginDate, vbShortDate)) ' Begining Date 
             dteTempEnd = CDate(FormatDateTime(Me.txtEndDate, vbShortDate))      ' End Date   
             ' Add one day to dteEndDate so Outlook will set the number of days correctly
             dteEndDate = DateSerial(Year(dteTempEnd + 1), Month(dteTempEnd + 1), Day(dteTempEnd + 1))

             .Start = dteStartDate
             .End = dteEndDate

         Else

             .Alldayevent = False

             If (Me.TxtBeginDate = Me.txtEndDate) Then

                ' Set the Start Property Value
                .Start = CDate(FormatDateTime(Me.TxtBeginDate, vbShortDate) _
                    & " " & FormatDateTime(Me.txtStartTime, vbShortTime))

                ' Set the End Property Value
                .End = CDate(FormatDateTime(Me.txtEndDate, vbShortDate) _
                     & " " & FormatDateTime(Me.txtEndTime, vbShortTime))

             Else

                ' Get the Start and the End Dates
                dteStartDate = CDate(FormatDateTime(Me.TxtBeginDate, vbShortDate))      
                dteEndDate = CDate(FormatDateTime(Me.txtEndDate, vbShortDate))     

                ' Add one day to dteEndDate so Outlook will set the number of days correctly
                .Start = dteStartDate
                .End = dteEndDate + 1

             End If
         End If

         If Len(Me.Employee & vbNullString) > 0 Then
            Dim vname, vname2, vdesc As String
            vname = DLookup("FirstName", "tblEmployees", "EmployeeID =  " & Me.Employee)
            vname2 = DLookup("LastName", "tblEmployees", "EmployeeID =  " & Me.Employee)
            vdesc = DLookup("Description", "tblCodesWork", "WorkCodeID  = " & Me.WorkCode)
             .Subject = vname & " " & vname2 & " - " & vdesc

         End If

         ' Save the Appointment Item Properties
         .Save

     End With

     ' Set chkAddedToOutlook to checked
     Me.chkAddedToOutlook = True

     ' Inform the user
     MsgBox "New Outlook Appointment Has Been Added!", vbInformation
 End If

出口： '释放内存 设置olAppt=Nothing 设置olApp=Nothing 出口接头

错误句柄： MsgBox“错误”和错误编号、vbCrLf和错误说明_ &vbCrLf&“在程序BTNADDaptToOutLook_中单击模块模块1” 继续离开那里

---

End Sub

我找到一个网站向我解释了这一点。它是：