Trying to modify Existing Outlook Appt Item Using Access

Using the form shown and code attached, I am able to successfully add an appointment in to an Outlook Calendar from Access.  At the same time, I also capture the EntryID of the appointment and store it in the Access table.  I did this thinking it would be the easiest and most unique way to find the entry at a later time.

(The four fields on the bottom right corner are normally hidden.  First one is the AppointmentID in Access table, second is oldApptDate in case date is being changed, third is ApptLength, and fourth is the captured Outlook EntryID.)

I am now also trying to account for the situation where the end user pulls up an existing appointment in Access (and also already in Outlook), and wants to modify it in some way (i.e. change to a different day, different time, add a note, etc.).  The code I am trying to use in the "modify" situation is in the section marked "Check to see if Appt is already in Outlook and, if so, modify instead of adding new."

When I pull up an existing appt, the code runs and completes giving me the "Appointment Modified!" message.  No errors!  However, the end result is that the Access table entry was modified, but the Outlook entry remains unchanged.

I also tried this with the If statement to compare EntryID instead of Subject:
If InStr(outappt.EntryID, Forms![frmAppointments]![EntryID]) Then

as well with the same result.  Can someone help me identify why my code is not modifying the Outlook record for the appointment?

Thanks!
Private Sub cmdNewRecord_Click()

Dim apptdat As Date
Dim apptStrTim As Date
Dim apptEndTim As Date

Dim outobj As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim outappt As Outlook.AppointmentItem
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)

Dim colCal As Outlook.Items
Dim colMyAppts As Outlook.Items
Dim intApptsKilled As Integer
Dim strFind As String
Set objapp = CreateObject("Outlook.Application")
Set objNS = objapp.GetNamespace("MAPI")
Set colCal = objNS.GetDefaultFolder(olFolderCalendar).Items
colCal.Sort "[Start]"
colCal.IncludeRecurrences = False

    Forms!frmAppointments.FilterOn = False
    
' Save record first to be sure required fields are filled.

    Me.ApptLength = DateDiff("n", ApptStartTime, ApptEndTime)

    DoCmd.RunCommand acCmdSaveRecord
    
    apptdat = Format(Forms![frmAppointments]![ApptDate], "dd mmm yyyy")
    apptStrTim = Format(Forms![frmAppointments]![ApptStartTime], "hh:mm AM/PM")
    apptEndTim = Format(Forms![frmAppointments]![ApptEndTime], "hh:mm AM/PM")
    
' Check to see if Appt is already in Outlook and, if so, modify instead of adding new.

If Me!AddedToOutlook = True Then

    apptdat = Forms![frmAppointments]![oldApptDate]

    'get appointments spanning 24hrs in date range of current day
    strFind = "[Start] > " & _
            Quote(apptdat & " 12:00 AM") & " AND [End] < " & _
            Quote(apptdat & " 11:59 PM")

    intApptsKilled = 0
    Set colMyAppts = colCal.Restrict(strFind)
    For Each outappt In colMyAppts
        If InStr(outappt.Subject, Forms![frmAppointments]![Appt]) Then

            Dim db As Database
            Dim appts_RST As Recordset
            Set db = CurrentDb
            Set appts_RST = db.OpenRecordset("tblAppointments", dbOpenDynaset)
            
            appts_RST.MoveFirst
            Do While (Not appts_RST.EOF)
            
                If (appts_RST![AppointmentID] = Forms![frmAppointments]![AppointmentID]) Then
                
                    Exit Do
                End If
                appts_RST.MoveNext
            Loop

            With outappt
                .Start = Me.ApptDate
                .Duration = Me.ApptLength
                .Subject = Me.Appt
                If Not IsNull(Me.ApptNotes) Then .Body = Me.ApptNotes
                If Not IsNull(Me.ApptLocation) Then .Location = Me.ApptLocation
                .ReminderSet = Me.ApptReminder
                If (Me.ApptReminder = True) Then .ReminderMinutesBeforeStart = Me.ReminderMinutes
                .Save
            End With
            
            intApptsKilled = intApptsKilled + 1
        End If
    Next
    
    ' Release the Outlook object variable.
        Set objapp = Nothing
    
    ' Set the AddedToOutlook flag, save the record, move to new record, and display a message.
        DoCmd.GoToRecord , , acNewRec
        MsgBox "Appointment Modified!"
        Exit Sub

Else
' Add a new appointment.
    With outappt
        .Start = Me!ApptDate & " " & Me!ApptStartTime
        .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
        
'get appointments spanning 24hrs in date range of current day
  strFind = "[Start] > " & _
            Quote(apptdat & " 12:00 AM") & " AND [End] < " & _
            Quote(apptdat & " 11:59 PM")
            

'Looks up appointment just logged to retrieve its unique EntryID to store in Access table entry
  intApptsKilled = 0
  Set colMyAppts = colCal.Restrict(strFind)
  For Each outappt In colMyAppts
    If InStr(outappt.Subject, Forms![frmAppointments]![Appt]) Then

        'MsgBox (outappt.EntryID)
        Me!EntryID = (outappt.EntryID)
        intApptsKilled = intApptsKilled + 1
     End If
  Next
        
    End With
End If

' Release the Outlook object variable.
    Set objapp = Nothing
    
' Set the AddedToOutlook flag, save the record, move to new record, and display a message.
    Me!AddedToOutlook = True
    DoCmd.GoToRecord , , acNewRec
    MsgBox "Appointment Added!"
    Exit Sub

AddAppt_Err:

    MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub

End Sub

Open in new window

Entry/Edit form for appointments
JohnMc0620Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Jeffrey CoachmanMIS LiasonCommented:
If you at this point, then you may want to manage your appointments in Outlook.
(either that of move this entire system to Access)

Access can do things like this but it is not easy.
And note that MS can change the way Access interacts with outlook without notice (thus "breaking" all your code
0
JohnMc0620Author Commented:
I understand your point.  And, I would love to be able to eliminate Outlook completely and just use Access.  It would make life a lot easier.  The reason I am involving Outlook in to the process is that I need this Access calendaring system to work with a Google online calendar.  I have not been able to find any way to directly connect Access to a Google account/calendar so that when an appointment is added/modified/deleted in Access, it populates the Google calendar at the same time.  The end user needs availability to their calendar on their SmartPhone.

Outlook give me real time availability to the Google account via MAPI.  So, that is why I need to have Access "talk" with Outlook regarding these scheduled appointments.  If you know a way to allow Access to directly communicate with a Google account, it would save me a lot of problems in using Outlook as a middleman.  Otherwise, I need a solution to my original question above.

Your comment makes sense and I wish I didn't have to do it this way.  I appreciate your feedback.  If you have any ideas or other comments, I am grateful for your input.  

Thanks!
0
JohnMc0620Author Commented:
Update Success!

I found that even though the correct record was showing on the form, the code was always looking at the first record in the table, and not the record that corresponded to the one showing on the form.  I removed the following code from the modify section:

Dim db As Database
Dim appts_RST As Recordset
Set db = CurrentDb
Set appts_RST = db.OpenRecordset("tblAppointments", dbOpenDynaset)
            
appts_RST.MoveFirst
Do While (Not appts_RST.EOF)
            
    If (appts_RST![AppointmentID] = Forms![frmAppointments]![AppointmentID]) Then
                
        Exit Do
    End If
    appts_RST.MoveNext
Loop

Open in new window


I replaced that code with the following statement:

DoCmd.GoToRecord acDataForm, "frmAppointments", acGoTo

Open in new window


I then changed the If statement to look at the unique EntryID instead of the Subject:

If InStr(outappt.EntryID, Forms![frmAppointments]![EntryID]) Then

Open in new window


It now will modify an existing Outlook entry!  Works like a charm!
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Jeffrey CoachmanMIS LiasonCommented:
Great, you can now accept your own post as the solution

;-)

JeffCoachman
0
JohnMc0620Author Commented:
I was able to resolve this on my own.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.