J
JoD
I am using Microsoft Office 2007 to create Outlook calendar appointments from
Access. I can successfully do this with one exception: I have a series of
calendars with similar names - the last portion of the name, for the 16
calendars, ranges from SEMI-1 to SEMI-16. With the code below, the .Resolve
method is unsuccessful for only the calendar ...SEMI-1.
I have verified that the name correctly matches the name of the calendar.
Any suggestions would be appreciated (including renaming that calendar, if
necessary!)
Dim objOutlook As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objRecipient As Outlook.Recipient
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim objAppt As Outlook.AppointmentItem
Dim myCalendar, strStart, strShortTime As String
'find and delete the corresponding calendar appointment
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
If Len(Trim(Nz(Me!cboCalendar.Column(0)))) > 0 Then ' proceed, should be
an appointment
myCalendar = strCalendar
Set objRecipient = objNameSpace.CreateRecipient(myCalendar)
' check calendar name
objRecipient.Resolve
If objRecipient.Resolved Then
' create start date/time
strStart = strExamDate & " " & strStartTime
strStart = Format(strExamDate & " " & strStartTime, "mm/dd/yyyy
hh:mm AMPM")
' set values for objects and delete appointment
Set objFolder =
objNameSpace.GetSharedDefaultFolder(objRecipient, olFolderCalendar)
Set objItems = objFolder.Items
Set objAppt = objItems.Find("[Start] = """ & strStart & """")
If objAppt Is Nothing Then
MsgBox ("This appointment was not found in Outlook")
Else
objAppt.Delete
Set objAppt = Nothing
'Now display appropriate message
MsgBox ("Appointment deleted from Outlook")
End If
Set objItems = Nothing
Set objFolder = Nothing
Else
MsgBox ("No appointment deleted, could not resolve calendar name")
End If
Else
MsgBox ("No appointment deleted, no existing appointment")
End If
'Release the object variables
Set objNameSpace = Nothing
Set objRecipient = Nothing
Set objOutlook = Nothing
Access. I can successfully do this with one exception: I have a series of
calendars with similar names - the last portion of the name, for the 16
calendars, ranges from SEMI-1 to SEMI-16. With the code below, the .Resolve
method is unsuccessful for only the calendar ...SEMI-1.
I have verified that the name correctly matches the name of the calendar.
Any suggestions would be appreciated (including renaming that calendar, if
necessary!)
Dim objOutlook As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objRecipient As Outlook.Recipient
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim objAppt As Outlook.AppointmentItem
Dim myCalendar, strStart, strShortTime As String
'find and delete the corresponding calendar appointment
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
If Len(Trim(Nz(Me!cboCalendar.Column(0)))) > 0 Then ' proceed, should be
an appointment
myCalendar = strCalendar
Set objRecipient = objNameSpace.CreateRecipient(myCalendar)
' check calendar name
objRecipient.Resolve
If objRecipient.Resolved Then
' create start date/time
strStart = strExamDate & " " & strStartTime
strStart = Format(strExamDate & " " & strStartTime, "mm/dd/yyyy
hh:mm AMPM")
' set values for objects and delete appointment
Set objFolder =
objNameSpace.GetSharedDefaultFolder(objRecipient, olFolderCalendar)
Set objItems = objFolder.Items
Set objAppt = objItems.Find("[Start] = """ & strStart & """")
If objAppt Is Nothing Then
MsgBox ("This appointment was not found in Outlook")
Else
objAppt.Delete
Set objAppt = Nothing
'Now display appropriate message
MsgBox ("Appointment deleted from Outlook")
End If
Set objItems = Nothing
Set objFolder = Nothing
Else
MsgBox ("No appointment deleted, could not resolve calendar name")
End If
Else
MsgBox ("No appointment deleted, no existing appointment")
End If
'Release the object variables
Set objNameSpace = Nothing
Set objRecipient = Nothing
Set objOutlook = Nothing