Hi Yaacov,
Although I am not used to provide full scripts, I had so much help of other
members in the past I'm willing to share it.
Just make a form as you would like and link it to a table with all required
fields and their formats. Within my table/form I do use some checkboxes
linked to a yes/no tablecolomn.
The only thing I am stil figuring out is how to create within my script an
appointment for the whole day. using .AllDayEvent = True as an optional.
start code:
Private Sub cmdAddAppt_Click()
On Error GoTo Add_Err
'Exit the procedure if appointment has been added to Outlook.
If Me!AddedToOutlook = True Then
MsgBox "This appointment already exists", vbInformation,
"Error Message"
Exit Sub
'Add a new appointment.
Else
If IsNull(Me!ApptStartDate) Then Me.ApptStartDate = Me.ApptDate
If IsNull(Me!ApptEndDate) Then Me.ApptEndDate = Me.ApptDate
If IsNull(Me!Appt) Then
MsgBox "With who?", vbInformation, "Error Message"
Exit Sub
End If
If IsNull(Me!ApptLocation) Then
MsgBox "Where?", vbInformation, "Error Message"
Exit Sub
End If
If IsNull(Me!ApptNotes) Then
MsgBox "No additional Information?", vbInformation, "Error
Message"
Exit Sub
End If
If IsNull(Me!ApptSubject) Then
MsgBox "No Subject?", vbInformation, "Error Message"
Exit Sub
End If
If IsNull(Me!ApptTime) Then
MsgBox "Starts at what time?", vbInformation, "Error Message"
Exit Sub
End If
'Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim objRecurPattern As Outlook.RecurrencePattern
Dim strInviteTo, strSubject As String
Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
strInviteTo = Me!ApptEmail
strSubject = Me!ApptSubject
With objAppt
.Start = Me!ApptStartDate & " " & 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
Set objRecurPattern = .GetRecurrencePattern
With objRecurPattern
.RecurrenceType = Me!ApptRecurrance
.Interval = 1
.PatternStartDate = Me!ApptStartDate
.PatternEndDate = Me!ApptEndDate
End With
End If
.Save
.Close (olSave)
End With
'Release the AppointmentItem object variable.
Set objAppt = Nothing
End If
'Release the Outlook object variable.
Set objOutlook = Nothing
'Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Your appointment has been added!"
Exit Sub
end code
