James Foxworthy
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.
Thank you!
Riverwalk
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
Thank you!
Riverwalk
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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
olMeeting
olMeetingCanceled
olMeetingReceived
olMeetingReceivedAndCancel
olNonMeeting
Check the value of the MeetingStatus property, and skip to the next appointment if it equals olMeetingCanceled (or maybe olMeetingReceivedAndCancel