T
TheShack
Hello. I'm new to VBA programming and need a bit of help. After searching the
internet I have found the following VBA code to add an appointment into
outlook from Access. I also need to be able to import appointments created in
outlook into an access table. How can I do this and can it be done using
automation?
Thanks
Private Sub 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!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
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 "Appointment Added!"
Exit Sub
Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
internet I have found the following VBA code to add an appointment into
outlook from Access. I also need to be able to import appointments created in
outlook into an access table. How can I do this and can it be done using
automation?
Thanks
Private Sub 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!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
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 "Appointment Added!"
Exit Sub
Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub