Article ID: 160502
Article Last Modified on 1/19/2007
149078 ACC: How to Add Appointments to Schedule+ using OLE Automation
Table: tblAppointments
--------------------------
Field Name: Appt
Data Type: Text
Field Size: 50
Required: Yes
Field Name: ApptDate
Data Type: Date/Time
Format: Short Date
Required: Yes
Field Name: ApptTime
Data Type: Date/Time
Format: Medium Time
Required: Yes
Field Name: ApptLength
Data Type: Number
Field Size: Long Integer
Default Value: 15
Required: Yes
Field Name: ApptNotes
Data Type: Memo
Field Name: ApptLocation
Data Type: Text
Field Size: 50
Field Name: ApptReminder
Data Type: Yes/No
Field Name: ReminderMinutes
Data Type: Number
Field Size: Long Integer
Default Value: 15
Field Name: AddedToOutlook
Data Type: Yes/No
Table Properties: tblAppointments
---------------------------------
PrimaryKey: ApptDate;ApptTime
NOTE: In this example, the primary key in the appointment table is the
appointment date and time. You can remove or alter the primary key if
you want to be able to add multiple appointments for the same date and
time.
Form: frmAppointments
-------------------------
Caption: Appointment Form
Form Header:
Height: .5"
Check Box: AddedToOutlook
Enabled: No
Command Button:
Name: AddAppt
Caption: Send to Outlook
OnClick: [Event Procedure]
Private Sub AddAppt_Click()
On Error GoTo AddAppt_Err
' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
If Me!AddedToOutlook = True Then
MsgBox "This appointment already added to Microsoft Outlook"
Exit Sub
' Add a new appointment.
Else
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)
With outappt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me!Appt
If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes
If Not IsNull(Me!ApptLocation) Then .Location = _
Me!ApptLocation
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
.Save
End With
End If
' Release the Outlook object variable.
Set outobj = Nothing
' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
Additional query words: integrate meeting OLE OutSol OutSol97
Keywords: kbfaq kbhowto kbinterop kbprogramming KB160502