Hi, I trying to create a new calendar appointment in Outlook using data I have from an Access database. I can get the data into Outlook fine, but I need it to go to a one of many shared calendar files that are not a part of the folder structure of the Outlook file I am logged into. The calendars do appear under the My Calendar tab and are shared with me. The appointment always shows up in the calendar that I am logged in as in Outlook. I need it to go to the shared calendar "MJP". I think I am missing a step here - any help would be greatly appreciated.
Private Sub Command61_Click()
Dim NS As Outlook.NameSpace
Dim objOwner As Outlook.Recipient
Dim oApp As Outlook.Application
Dim oItem As AppointmentItem
Dim newCalFolder As Outlook.Folder
Set oApp = Outlook.Application
If Err <> 0 Then
Set oApp = CreateObject("Outlook.Application")
End If
Set NS = oApp.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("MJP")
objOwner.Resolve
If objOwner.Resolved Then
MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If
Set oItem = oApp.CreateItem(olAppointmentItem)
With oItem
.Subject = "This is a test "
.Start = "23/06/2015 11:45"
.Location = "Room 101"
Select Case 1
Case 1
.Display
Case 2
.Save
End Select
End With
Set oApp = Nothing
Set NS = Nothing
End Sub
Private Sub Command61_Click()
Dim NS As Outlook.NameSpace
Dim objOwner As Outlook.Recipient
Dim oApp As Outlook.Application
Dim oItem As AppointmentItem
Dim newCalFolder As Outlook.Folder
Set oApp = Outlook.Application
If Err <> 0 Then
Set oApp = CreateObject("Outlook.Application")
End If
Set NS = oApp.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("MJP")
objOwner.Resolve
If objOwner.Resolved Then
MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If
Set oItem = oApp.CreateItem(olAppointmentItem)
With oItem
.Subject = "This is a test "
.Start = "23/06/2015 11:45"
.Location = "Room 101"
Select Case 1
Case 1
.Display
Case 2
.Save
End Select
End With
Set oApp = Nothing
Set NS = Nothing
End Sub