Avatar of JohnMc0620
JohnMc0620 asked on

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
OutlookMicrosoft Access

Avatar of undefined
Last Comment
JohnMc0620

8/22/2022 - Mon
Jeffrey Coachman

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
ASKER
JohnMc0620

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!
ASKER CERTIFIED SOLUTION
JohnMc0620

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Jeffrey Coachman

Great, you can now accept your own post as the solution

;-)

JeffCoachman
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
ASKER
JohnMc0620

I was able to resolve this on my own.