我正在尝试将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
答案 0 :(得分:0)