We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
It appears to work, because the appointment is appearing in my calendar, but the recipient is not getting the meeting request. As a result of the Save and Send actions, I'm getting the following two popups (I assume these have to do with Outlook security). When I open the appointment in my calendar, the To box and Required Attendees show the email address of the individual I have entered in the code, but the status bar (above the To: box) says "Invitations have not been sent for this meeting". I assumed that the .Send method would actually send the message but that does not seem to be happening.
Public golApp As Outlook.Application Public golNameSpace As Outlook.NameSpace Function Initialise_Outlook() As Boolean On Error GoTo Init_err Set golApp = New Outlook.Application Set golNameSpace = golApp.GetNamespace("MAPI") Initialise_Outlook = True Init_Bye: Exit Function Init_err: Initialise_Outlook = False Resume Init_Bye End Function Function CreateAppointment(MyStartDateTime As Date, MyEndDateTime As Date, _ MySubject As String, MyLocation As String, _ MyReminder As Boolean, MyBody As String) Dim objNewAppt As Outlook.AppointmentItem ' Set global Application and NameSpace ' object variables, if necessary. If golApp Is Nothing Then If Initialise_Outlook() = False Then ' You'll need to handle this error ' in your own code. MsgBox "Unable to initialize Outlook. " Exit Function End If End If Set objNewAppt = golApp.CreateItem(olAppointmentItem) With objNewAppt .AllDayEvent = False ' Set MyProp = .UserProperties.Add("MyClass", olText) ' MyProp.Value = MyClassName .Start = MyStartDateTime .End = MyEndDateTime .Subject = MySubject ' .Categories = MyCategories .ReminderSet = False .BusyStatus = olBusy .Location = MyLocation .Body = MyBody If MyReminder = True Then .ReminderSet = True .ReminderMinutesBeforeStart = 1 End If 'add recipients here (obviously not the values I'm actually using) .Recipients.Add "X.Y@test.net" .RequiredAttendees = "email@example.com" .Recipients.ResolveAll .Save .Send End With CreateAppointment = True End Function