helphelphelp
Registered User.
- Local time
- Yesterday, 21:32
- Joined
- Feb 18, 2006
- Messages
- 15
Hello people, wonder if anyone can help with this code, I got the code of the net and wanted it tweaking if anyone can help.
I have created a form that updates Outlook calender the trouble is that I want it to set reaccurances ever 13 weeks not every week. I would also like it to stop back dating as it makes the reminders box pop up, in fact if you can show me how to get rid of this as Im not to worried about reminders.
Below is the code for the command button, please be aware before you baffle my head with science I am not an access guru, just on a basic form making level.
oh is it also possible to show a message box if there is already a appointment in the outlook calender, or am I now asking far to much
cmdAddAppt_Click()
On Error GoTo Add_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 is already added to Microsoft Outlook"
Exit Sub
'Add a new appointment.
Else
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim objRecurPattern As Outlook.RecurrencePattern
Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
With objAppt
.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
Set objRecurPattern = .GetRecurrencePattern
With objRecurPattern
.RecurrenceType = olRecursWeekly
.Interval = 1
'Once per week
.PatternStartDate = #7/9/2003#
'You could get these values
'from new text boxes on the form.
.PatternEndDate = #7/23/2003#
End With
.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 "Appointment Added!"
Exit Sub
Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
I have created a form that updates Outlook calender the trouble is that I want it to set reaccurances ever 13 weeks not every week. I would also like it to stop back dating as it makes the reminders box pop up, in fact if you can show me how to get rid of this as Im not to worried about reminders.
Below is the code for the command button, please be aware before you baffle my head with science I am not an access guru, just on a basic form making level.
oh is it also possible to show a message box if there is already a appointment in the outlook calender, or am I now asking far to much
cmdAddAppt_Click()
On Error GoTo Add_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 is already added to Microsoft Outlook"
Exit Sub
'Add a new appointment.
Else
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim objRecurPattern As Outlook.RecurrencePattern
Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
With objAppt
.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
Set objRecurPattern = .GetRecurrencePattern
With objRecurPattern
.RecurrenceType = olRecursWeekly
.Interval = 1
'Once per week
.PatternStartDate = #7/9/2003#
'You could get these values
'from new text boxes on the form.
.PatternEndDate = #7/23/2003#
End With
.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 "Appointment Added!"
Exit Sub
Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub