[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 420
  • Last Modified:

VBA Outlook with MS Access -Determine Changes to Appointment

Hi, I am using this code to add appointments in Access 2003 to an Outlook Calendar

''UPDATE CALENDAR SECTION'''
 
  ' strFolderPath needs to be something like
  '   "Public Folders\All Public Folders\Workgroup Folders\A - Ae\ACCESS TEAM TWO" or
  '   "Personal Folders\Inbox\My Folder", etc
 
  Dim objApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim colFolders As Outlook.Folders
  Dim objFolder As Outlook.MAPIFolder
  Dim arrFolders() As String
  Dim strFolderPath As String
  Dim objAppt As Outlook.AppointmentItem
  Dim jobrole As String
  Dim qrySQL As String
  Dim i As Long
  On Error Resume Next
 
 
'Access the appropriate calendar
  strFolderPath = "Public Folders\All Public Folders\Workgroup Folders\A - Ae\" & jobrole ' "A - Ae", not "A-AE"!!!
  arrFolders() = Split(strFolderPath, "\") 'Notice the delimiter. Splits the folder heirarchy into an array.
  Set objApp = CreateObject("Outlook.Application")
  Set objNS = objApp.GetNamespace("MAPI")
  Set objFolder = objNS.Folders.Item(arrFolders(0))
  If Not objFolder Is Nothing Then
    For i = 1 To UBound(arrFolders) 'Scroll through the folders array
      Set colFolders = objFolder.Folders
      Set objFolder = Nothing
      Set objFolder = colFolders.Item(arrFolders(i)) 'And we're scrolling....
      If (objFolder = jobrole) Then 'We found it!
            Set objAppt = objFolder.Items.Add()
            If Not objAppt Is Nothing Then 'If it is Nothing, Outlook couldn't substantiate the appt
                With objAppt
                    .Subject = Me.fullname.Column(1)
                    .Start = Me.date1.Value
                    .End = Me.date2.Value
                    .Save
                End With
                Exit For
            Else
                MsgBox ("For an unknown reason, Access could not create an appointment in this calendar at this time.")
            End If
        End If
    Next
  End If
 
  Set GetFolder = objFolder
  Set colFolders = Nothing
  Set objNS = Nothing
  Set objApp = Nothing

I also have a variable that reads the GUID created when I add the record from Access to Outlook Calendar.

What I need it do to is determine if the record has already been added, if so, instead of simply re-adding the appointment in Outlook, I want to have the code check if any changes have been made since it was added in Calendar, and Update the Calendar Appointment Record.

Any suggestions are welcome.

Jfer
0
jfer0x01
Asked:
jfer0x01
  • 2
1 Solution
 
puppydogbuddyCommented:
The  attached code from this link might be what you need:
             http://msdn.microsoft.com/en-us/library/aa168454(office.11).aspx
Sub SetControlItemPropertyExample()
    Dim myInspector As Outlook.Inspector
    Dim myAppt As Outlook.AppointmentItem
    Dim ctrl As Object
    Dim ctrls As Object
    Dim myPages As Outlook.Pages
    Dim myPage As Object
    
    Set myAppt = Application.CreateItem(olAppointmentItem)
    Set myInspector = myAppt.GetInspector
    myAppt.MeetingStatus = olMeeting
    myAppt.Subject = "Test Appointment"
    Set myPages = myInspector.ModifiedFormPages
    Set myPage = myPages.Add("Binding Example")
    Set ctrls = myPage.Controls
    Set ctrl = ctrls.Add("Forms.TextBox.1")
    ctrl.Top = 10
    ctrl.Left = 10
    myInspector.SetControlItemProperty ctrl, "To"
    myAppt.Display
End Sub

Open in new window

0
 
puppydogbuddyCommented:
From this link, use the following command line switch:
         http://www.outlook-tips.net/howto/commandlines.htm


/sniff

Starts Outlook and forces a detection of new meeting requests in the Inbox, and then adds them to the calendar.
0
 
jfer0x01Author Commented:
I have not had any time to attempt this
0

Featured Post

Prep for the ITIL® Foundation Certification Exam

December’s Course of the Month is now available! Enroll to learn ITIL® Foundation best practices for delivering IT services effectively and efficiently.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now