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

时间:2014-03-25 15:19:38

标签: calendar ms-access-2010 outlook-2010 public-folders

我正在尝试将Access 2010中的日历约会添加到Outlook公共日历中。我已经找到了几种方法来实现这一点,但似乎无法使用我的代码。可能存在的一个问题是,当我设置要保存的文件夹时,我不明白代码在做什么。这是我保存到Outlook日历的代码。如何将其保存到名为janettest的公共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

ExitHere:      '释放记忆      设置olAppt = Nothing      设置olApp = Nothing      退出子

ErrHandle:      MsgBox“错误”& Err.Number& vbCrLf&错误描述_      &安培; vbCrLf& “在模块模块1中的过程btnAddApptToOutlook_Click”      恢复ExitHere

End Sub

相关问题