megatronixs
Registered User.
- Local time
- Today, 19:39
- Joined
- Aug 17, 2012
- Messages
- 719
Hi all,
 
I'm trying to make the below code work to add a reminder for another user in outlook. I use the appointment part. I works really nice on my outlook, but does not work on others Microsoft outlook exchange.
Any clue where I go wrong?
 
 
	
	
	
		
 
Greetings.
 I'm trying to make the below code work to add a reminder for another user in outlook. I use the appointment part. I works really nice on my outlook, but does not work on others Microsoft outlook exchange.
Any clue where I go wrong?
		Code:
	
	
	Option Compare Database
Private Sub AddAppt_Click()
' 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 objNS As Outlook.NameSpace
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)
Set objNS = outobj.GetNamespace("MAPI")
With outappt
'.Recipients.Add (Me!AppAttendee)
        Set objFolder = _
          objNS.GetSharedDefaultFolder(.Recipients.Add(Me!AppAttendee), olFolderCalendar)
          
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me!Appt
If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes
If Not IsNull(Me!ApptLocation) Then .Location = _
Me!ApptLocation
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
.Save
End With
End If
' Release the Outlook object variable.
Set outobj = Nothing
' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End SubGreetings.
 
	 
 
		 
 
		
 
 
		 
 
		