Link to home
Start Free TrialLog in
Avatar of James Foxworthy
James FoxworthyFlag for United States of America

asked on

MS Access VBA -- How to use OlMeetingStatus & olMeetingCanceled (These are MS Outlook objects)

I have VBA code that pulls Outlook calendar data out of Outlook and into an MS Access table, but it is retreiving cancelled/deleted meetings. I found a reference to OlMeetingStatus & olMeetingCanceled at the below link but I don't understand how to use them.
http://msdn.microsoft.com/en-us/library/microsoft.office.interop.outlook.olmeetingstatus.aspx

I don't know if OlMeetingStatus represents another field I can pull into Access out of the Outlook calendar, in the manner shown by the below code, or if it's something else.  I either need to exclude the canceled meetings from being pulled into Access or pull them into access along with a field that will identified which ones have been canceled. Can you please help?

I have included a code example of how I'm pulling the data out of Outlook. This is not the entire code section, but enough possibly to show you what I'm talking about.

Set olItems = olFldr.Items
  iNumItems = olItems.Count
  Set db = CurrentDb
  'Commenting this line out because I do this deletion in the code that calls this function. Don't need to do it again here.
  'db.Execute "Delete * from OutlookAppointments", dbFailOnError
  Set rs = db.OpenRecordset("OutlookAppointments")
  For i = 1 To iNumItems
    If TypeName(olItems(i)) = "AppointmentItem" Then
      Set olAppt = olItems(i)
      With olAppt
        rs.AddNew
        rs!EntryID = .EntryID
        rs!StartTime = .Start
        rs!EndTime = .End
        rs!Duration = .Duration
        rs!Subject = .Subject
        rs!Location = .Location
        rs!Organizer = .Organizer
        rs!RequiredRecipients = .RequiredAttendees
        rs!OptionalRecipients = .OptionalAttendees
        'rs!Body = .Body
        ' For user-defined properties:
        ' rs!FieldName = .UserProperties("PropertyName")
        rs.Update
        iCount = iCount + 1
      End With
    End If
  Next i

Open in new window


Thank you!
Riverwalk
Avatar of Helen Feddema
Helen Feddema
Flag of United States of America image

AppointmentItems have a MeetingStatus property, which is set with one of the named constants from the OlMeetingStatus enum.  They are:

olMeeting
olMeetingCanceled
olMeetingReceived
olMeetingReceivedAndCanceled
olNonMeeting

Check the value of the MeetingStatus  property, and skip to the next appointment if it equals olMeetingCanceled (or maybe olMeetingReceivedAndCanceled as well).
ASKER CERTIFIED SOLUTION
Avatar of Helen Feddema
Helen Feddema
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of James Foxworthy

ASKER

Thank you very much. Can you please provide an example of the syntax, how to set the reference and how to check the value of the MeetingStatus fo rcancled? Sorry. I do a lot of VBA development within Access but this particular coding is above my head.

Thank you!
Riverwalk
Here is a portion of some code I wrote for my Working with Outlook ebook (which is available from the Office Watch Website):

Private Sub cmdCreateItems_Click()
'Created by Helen Feddema 7-Sep-2009
'Last modified by Helen Feddema 25-Feb-2012

On Error GoTo ErrorHandler

   Dim dteEndTime As Date
   Dim dteLastMeeting As Date
   Dim dteNextMeeting As Date
   Dim dteStartTime As Date
   Dim i As String
   Dim intChoiceAccess As Integer
   Dim intChoiceOutlook As Integer
   Dim intColumn As Integer
   Dim intColumns As Integer
   Dim intItemCount As Integer
   Dim lngContactID As Long
   Dim lngStatus As Long
   Dim intCount As Integer
   Dim intIndex As Integer
   Dim intRow As Integer
   Dim intRows As Integer
   Dim lst As Access.ListBox
   Dim prps As Object
   Dim strAccessTable As String
   Dim strAddress As String
   Dim strBody As String
   Dim strCellPhone As String
   Dim strCity As String
   Dim strCompanyName As String
   Dim strAssignedTo As String
   Dim strAssignedToAndJob As String
   Dim strContactName As String
   Dim strCountry As String
   Dim strDateType As String
   Dim strDefault As String
   Dim strEmail As String
   Dim strFirstName As String
   Dim strFolder As String
   Dim strJobTitle As String
   Dim strLastName As String
   Dim strLocation As String
   Dim strLongDate As String
   Dim strNotes As String
   Dim strPostalCode As String
   Dim strPrompt As String
   Dim strReferredBy As String
   Dim strSalutation As String
   Dim strShortDate As String
   Dim strState As String
   Dim strStatus As String
   Dim strStreetAddress As String
   Dim strSubject As String
   Dim strTask As String
   Dim strTitle As String
   Dim strWorkFax As String
   Dim strWorkPhone As String
   Dim varItem As Variant
   
   intChoiceAccess = CInt(GetProperty("AccessTable", ""))
   
   If intChoiceAccess = olContactItem Then
      Set lst = Me![lstSelectContacts]
      lst.Visible = True
      Me![lstSelectTasks].Visible = False
      strAccessTable = "contact"
      strTitle = "No contacts selected"
      strPrompt = "Please select at least one contact"
   ElseIf intChoiceAccess = olTaskItem Then
      Set lst = Me![lstSelectTasks]
      lst.Visible = True
      Me![lstSelectContacts].Visible = False
      strAccessTable = "task"
      strTitle = "No tasks selected"
      strPrompt = "Please select at least one task"
   End If
   
   'Check that at least one item has been selected
   If lst.ItemsSelected.Count = 0 Then
      MsgBox prompt:=strPrompt, _
         Buttons:=vbInformation + vbOKOnly, _
         Title:=strTitle
      lst.SetFocus
      GoTo ErrorHandlerExit
   Else
      intColumns = lst.ColumnCount
      intRows = lst.ItemsSelected.Count
   End If
   
   Set appOutlook = GetObject(, "Outlook.Application")
   Set nms = appOutlook.GetNamespace("MAPI")
   intChoiceOutlook = Nz(Me![fraItemType].Value)
   
   If intChoiceAccess = olContactItem Then
      
      Select Case intChoiceOutlook
      
         Case olAppointmentItem
            strFolder = "Calendar folder"
            strItemType = "Appointment"
            intItemCount = 0

            strPrompt = "Enter location for appointment:"
            strTitle = "Location"
            strDefault = "Small conference room"
            strLocation = InputBox(strPrompt, strTitle, strDefault)
            
            'Process selected contacts
            For Each varItem In lst.ItemsSelected
               varLastMeeting = Nz(lst.Column(13, varItem))
               
               If IsDate(varLastMeeting) = False Then
                  GoTo NextContactA
               Else
                  dteNextMeeting = NextMonday
                  dteStartTime = CDate(CStr(dteNextMeeting) & " 9:00 AM")
                  dteEndTime = CDate(CStr(dteNextMeeting) & " 10:00 AM")
               End If
            
               'Create a new appointment item in the default Calendar folder
               Set appt = appOutlook.CreateItem(olAppointmentItem)
                
               With appt
                  .Subject = "Next project meeting"
                  .Start = dteStartTime
                  .End = dteEndTime
                  .Location = strLocation
                  .MeetingStatus = olMeeting
                  .Body = "This is your monthly review of project status"
                  
                  'Get full name of linked contact
                  strContactName = Nz(lst.Column(2, varItem)) & " " _
                     & Nz(lst.Column(3, varItem))
                  Debug.Print "Contact name: " & strContactName
                  
                  If strContactName <> "" Then
                     'The Links collection corresponds to the Contacts button
                     'in the interface, and a link has to be a valid recipient,
                     'so we have to check that the FullName value is a valid
                     'Outlook contact before adding it as a link
                     Set rcp = nms.CreateRecipient(strContactName)
                     'Debug.Print "Recipient created? " & Not rcp Is Nothing
                     rcp.Resolve
                     'Debug.Print "Recipient resolved? " & rcp.Resolved
                                 
                     If rcp.Resolved = True Then
                        .Links.Add rcp
                     Else
                        Debug.Print "Can't add " & strContactName & _
                           " as a contact for this appointment"
                     End If
                  End If
               
                  .Close (olSave)
               End With
   
               intItemCount = intItemCount + 1
               
NextContactA:
            Next varItem

Open in new window

User generated image To set a reference to the Outlook object model, open the References dialog from the Tools menu in the VB window, and select the Outlook item (whatever version you are running).  Here it is for Outlook 2003: