Below i have tried to combine two sets of code. I can create outlook appointments on the account im logged in as but want to create them on the shared calendar.
currrent error: "Object variable or with block variable not set"
Although I think there will be more issues than just that.
"Set outappt = outobj.objOwner.items.add(olAppointmentItem)" < this may be incorrect from what I've seen.
The debug isnt highlighting any lines, Hope someone here can advise.
Code:
Private Sub Command39_Click()
''''''''''''''''''''''''''''''''''''test'''''''''''''''''''''''''''''''''''''''''
On Error GoTo AddAppt_Err
' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
If Me!AddedToOutLook = True Then
MsgBox "This appointment already added to Microsoft Outlook"
Exit Sub
' Add a new appointment.
Else
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Dim NS As Outlook.NameSpace
Dim objOwner As Outlook.Recipient
Dim newFolder As Outlook.Folder
Set NS = outobj.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("calendar@test.co.uk")
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.objOwner.items.add(olAppointmentItem)
'objOwner.Resolve
'If objOwner.Resolved Then
Set newFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
'End If
With outappt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me!Appt
.Categories = "red;"
.ReminderSet = False
.AllDayEvent = True
If Not IsNull(Me!Postcode) Then
.Body = vbCrLf & "Map: http://www.google.com/maps?q=" & Me!Postcode & "+UK" & vbCrLf & vbCrLf & "Start Time: " & Me!ApptTime & vbCrLf & vbCrLf & "Notes From Previous Visits Are for Reference:" & vbCrLf & vbCrLf & Me!ApptNotes
Else
.Body = vbCrLf & vbCrLf & "Start Time: " & Me!ApptTime & vbCrLf & vbCrLf & "Notes From Previous Visits Are for Reference:" & vbCrLf & vbCrLf & Me!ApptNotes
End If
If Not IsNull(Me!ApptLocation) Then .Location = _
Me!ApptLocation
'If Me!ApptReminder Then
'.ReminderMinutesBeforeStart = Me!ReminderMinutes
'.ReminderSet = True
'End If
.Save
End With
' Release the Outlook object variable.
Set outobj = Nothing
' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutLook = True
DoCmd.SetWarnings False
DoCmd.RunCommand acCmdSaveRecord
DoCmd.OpenQuery "incriment visit"
DoCmd.SetWarnings True
DoCmd.GoToRecord , , acNext
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End If
End Sub
Thanks Andy.