T
tboyce
I have referred to the link on the help site which i have adapted for my own
db but it not seem to do anything at all can anyone spot where i am being a
lump.
Private Sub AddAppt_Click()
On Error GoTo Add_Err
'This is the original code from microsoft
'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.AddedOutlok = True Then
Msgbox "This appointment is already added to Microsoft Outlook"
Exit Sub
'My added line of code "Add a new appointment".
' I have a check box "Add App" to filter my results on my subform
If Me.AddApp = -1 Then
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.JobDate
.Duration = 0.15
.Subject = Me.JobDesc + Me.Reg
'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.AddedOutlok = True
DoCmd.RunCommand acCmdSaveRecord
Msgbox "Appointment Added!"
Exit Sub
Add_Err:
Msgbox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
db but it not seem to do anything at all can anyone spot where i am being a
lump.
Private Sub AddAppt_Click()
On Error GoTo Add_Err
'This is the original code from microsoft
'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.AddedOutlok = True Then
Msgbox "This appointment is already added to Microsoft Outlook"
Exit Sub
'My added line of code "Add a new appointment".
' I have a check box "Add App" to filter my results on my subform
If Me.AddApp = -1 Then
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.JobDate
.Duration = 0.15
.Subject = Me.JobDesc + Me.Reg
'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.AddedOutlok = True
DoCmd.RunCommand acCmdSaveRecord
Msgbox "Appointment Added!"
Exit Sub
Add_Err:
Msgbox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub