Excel VBA creating a new Outlook appointment results in a cancelled appointment

0 votes

I can send the resulting meeting request and it is accepted by the recipient as a meeting request when I run the following code with.display and the Outlook Appointment is formed correctly (shared calendar, recipients, time, etc.). The recipient receives a meeting cancellation for a meeting that doesn't exist, yet everything seems to work fine if I change.display to.send.

Could someone please explain where I'm going wrong?

Sub CreateMeetings()

Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim r As Long
Dim oApp As Object
Dim oNameSpace As Namespace
Dim myCalendar As Object
Dim OLNS As Object
Const olAppointmentItem As Long = 1
Dim OLAppointment As Object
Dim MeetingKey As String
Dim datenum As Long
Dim smtprecipient As String
Dim MeetingKeyString As String
Dim emailchk As Long



Set oApp = New Outlook.Application
Set olApp = CreateObject("Outlook.Application")

On Error Resume Next


Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook is not available!"
Exit Sub
End If
End If
'get default user email address
smtprecipient = GetSMTPEmailAddress

'check to see if email address returned is a valid one
emailchk = InStr(1, smtprecipient, "@company_domain.co.uk")
'get a valid email address if the check fails
If emailchk = 0 Then
    smtprecipient = InputBox("Enter your Company Email Address", "Email Address Required")
End If


Set OLNS = olApp.GetNamespace("MAPI")
    OLNS.Logon
    Dim objRec As Outlook.Recipient
    Set objRec = OLNS.CreateRecipient(smtprecipient)
    objRec.Resolve
    Set myCalendar = OLNS.GetSharedDefaultFolder(objRec, olFolderCalendar).Folders("Frontline")
    Set OLAppointment = myCalendar.Items.Add(olAppointmentItem)
    Dim i As Long, Schedsht As Worksheet
    Set Schedsht = Worksheets("Shift Allocation")
    Sheets("Shift Allocation").Select

For i = 6 To Range("A" & Rows.Count).End(xlUp).Row
If Schedsht.Range("T" & i).Value = "" And Schedsht.Range("S" & i).Value = True Then
datenum = Date + (Time * 10000) + i
MeetingKeyString = Schedsht.Range("Z" & i).Value
MeetingKey = "S" & CStr(datenum) & Schedsht.Range("B" & i).Value
    With OLAppointment
            .Subject = "Shift" & " (" & MeetingKey & ")"
            .RequiredAttendees = Schedsht.Range("I" & i).Value & ";" & Schedsht.Range("J" & i).Value _
             & ";" & Schedsht.Range("K" & i).Value
            .Start = Schedsht.Range("D" & i).Value
            .End = Schedsht.Range("E" & i).Value
            .Location = Schedsht.Range("C" & i).Value
            .ReminderMinutesBeforeStart = 720
            .MeetingStatus = olMeeting
            
            .Body = Schedsht.Range("M" & i).Value & vbCrLf & vbCrLf & "Welcome to our new Rota system. For details on how this all works, _
            please go to xxxx."
           .Display
            '.Send
        On Error GoTo 0
    End With

Schedsht.Range("T" & i).Value = True
Schedsht.Range("Y" & i).Value = MeetingKey
Schedsht.Range("AA" & i).Value = MeetingKeyString
Else

End If

Next i
 
MsgBox "All Shifts Processed"
Set olAppItem = Nothing
Set olApp = Nothing
Set oFolder = Nothing

Exit Sub

Set olAppItem = Nothing
Set olApp = Nothing
Set oFolder = Nothing
End Sub

See above. changing to .display works OK, but .send doesn't

Feb 14, 2023 in Others by narikkadan
• 63,720 points
786 views

1 answer to this question.

0 votes

Because an inappropriate sender will be used, you cannot directly transfer objects from a shared folder. When you need to send anything on behalf of someone else, you can use the SentOnBehalfOfName property for mail items but not appointments.

answered Feb 14, 2023 by Kithuzzz
• 38,020 points

Related Questions In Others

0 votes
1 answer

Creating a function in excel VBA to calculate the average point in a circular set of numbers

I used the following code to determine ...READ MORE

answered Oct 28, 2022 in Others by narikkadan
• 63,720 points
1,106 views
0 votes
1 answer

Activating a Specific Cell in Excel Using VBA Results to Error 400

I think you trying to select cells(4, ...READ MORE

answered Dec 27, 2022 in Others by narikkadan
• 63,720 points
491 views
0 votes
1 answer
0 votes
1 answer

Excel-VBA - How to identify Target range (more than 1 cell) is deleted in a Worksheet_Change function?

You misunderstand the purpose of the function ...READ MORE

answered Sep 23, 2022 in Others by narikkadan
• 63,720 points
3,581 views
0 votes
1 answer

Export All appointments and meetings (including recurring meetings) Excel VBA

However, when I use the code above ...READ MORE

answered Feb 13, 2023 in Others by narikkadan
• 63,720 points
1,590 views
0 votes
1 answer

Why does this VBA Macro that copies and paste range into email in the wrong order?

When a message body is created by ...READ MORE

answered Mar 21, 2023 in Others by Kithuzzz
• 38,020 points
725 views
0 votes
1 answer

Embed picture in outlook mail body excel vba

The image needs to be added and ...READ MORE

answered Dec 16, 2022 in Others by narikkadan
• 63,720 points
5,312 views
0 votes
1 answer

VBA How to extract the date and time of arrival of a answered email

Use MailItem.ReceivedTime property. I hope this helps you ...READ MORE

answered Jan 9, 2023 in Others by narikkadan
• 63,720 points
2,791 views
0 votes
1 answer
0 votes
1 answer
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP