VBA code to insert appointment in Outlook

  • Thread starter Thread starter Thomas Kroljic
  • Start date Start date
T

Thomas Kroljic

I created a test form based on MS Knowledge Base 160502.

It appears to work on my local desktop, but if I move the test mdb to my
terminal server and then login and run the application, there seems to be a
latent period of time before the Outlook Calendar is updated. Is this
normal? Her is the code from 160502:

' 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

Thank you,
Thomas Kroljic
 
You will find that the process is quicker if Outlook was already open. (This
is presumably the case on the desktop), as the code does not have to start
the automation object to connect to Outlook and then close it again when you
destroy the reference to Outlook at the end of your procedure.

I have a number of databases that write to Outlook and find that delay is
minimised if the database is split into front end and back end with the
front end on the workstation and the back end on a server. I always suggest
to users that they have Outlook open on the desktop to minimise delays also.
Seems to run OK for the users as no complaints so far.

Dave
 
Dave,
Thanks for your response and explanation. I'm new to this "Office
Automation" stuff. I'll give it a try with Outlook open to see if I see a
difference. I know I can live with the time delay, now I have to see if the
enduser can.

Thomas J. Kroljic
 
Thomas,

There are a couple of other things you could try to speed up things also:

If Outlook is already running, you don't want to create another instance to
set the appointment item.

Use Getobject to reference an already running instance of Outlook like this
(Place the function in a module and set a Public variable
OutlookWasNotRunning as Boolean in the same module). Also set these in the
module
Public outobj As Outlook.Application
Public outappt As Outlook.AppointmentItem

Function LaunchOutlook()
On Error Resume Next
Set outobj = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
OutlookWasNotRunning = True
Else
OutlookWasNotRunning = False
End If
If Err.Number <> 0 Then Set outobj = CreateObject("Outlook.Application")
Err.Clear ' Clear Err object in case error occurred.
If Not outobj Is Nothing Then
LaunchOutlook = True
Else
LaunchOutlook = False
End If
End Function

Your code would then look like this:

' 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
If LaunchOutlook=True then
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 variables.
Set outappt=Nothing
If OutlookWasNotRunning=True then Set outobj = Nothing
Else
Set outobj = Nothing
MsgBox "Could not start Outlook",VbInformation,"Error"
Exit Sub
End If
' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!",VbInformation,"Success"
Exit Sub

Just watch for line wrapping in the above code

Out of interest, your code will work if the appointment is to go in your own
calendar, changes would be necessary to place an appointment in another
users calendar. Also, what happens if you already have an appointment
covering that date and time in your calendar?

Hope this helps

Dave
 
Is it normal that this dosen't work when outlook is connected to an exchange
server 2003?

Thanks

JS.
 
Back
Top