Excel VBA - Creating Outlook Meeting (Send from designated email)

[MrHydrant1857]

Hello All,
I am working on a program that creates appointments in Outlook. I have 5, rooms / email addresses, that I am working with. What I want to happen is to use email one (Master) as the organizer and send invites to the other rooms based on a cell value. I can easily figure out the sending invites to the specific rooms, but I am needing help figuring out how to set up email one (Master) as the organizer. Currently when I run my program the invite is sent through the users Outlook App (their personal email). Is there a way to bypass this and have it automatically send from the Master email? I found a video on this where it talked about sending meeting invites from different emails, but I think you might have to add the accounts to the outlook app? Any help would be appreciated!

 

[Skybluekid]

Are you able to post the code you are using?

 

[MrHydrant1857]

 

[Skybluekid]

Do the user have access to the Master Email? If so, the you can use the .SendUsingAccout. This You Tube video should be of assistance.

 

[MrHydrant1857]

Do the user have access to the Master Email? If so, the you can use the .SendUsingAccout. This You Tube video should be of assistance.

Ok this is perfect and i have watched a similar video of this. So basically I will need to have every user add the "Master" account to their outlook app for this to work. What if the "Master" email is just an alias and not a licensed email?

 

[Skybluekid]

Yes, they would have to have access to that account. What do you mean an "alias"?

 

[MrHydrant1857]

Ok so I have access to the master email, but I cannot send on behalf of. any thoughts on why this isnt working?

Sub AddAppointments()
'Update by Extendoffice 20180608
Dim i As Long
Dim xRg As Range
Dim xOutApp As Object
Dim xOutItem As Object
Dim XEmailAlias As String
XEmailAlias = "masterverizoncellphone@hydrants.com"
Set xOutApp = CreateObject("Outlook.Application")
Set xRg = Sheets("Follow up for Outlook Calendar").Range("A2:G2")
For i = 1 To xRg.Rows.Count
Set xOutItem = xOutApp.CreateItem(1)
Debug.Print xRg.Cells(i, 1).Value
xOutItem.Subject = xRg.Cells(i, 1).Value
xOutItem.MeetingStatus = olMeeting
xOutItem.Location = xRg.Cells(i, 2).Value
xOutItem.Start = xRg.Cells(i, 3).Value
xOutItem.Duration = xRg.Cells(i, 4).Value


If Trim(xRg.Cells(i, 5).Value) = "" Then
xOutItem.BusyStatus = 2
Else
xOutItem.BusyStatus = xRg.Cells(i, 5).Value
End If
If xRg.Cells(i, 6).Value > 0 Then
xOutItem.ReminderSet = True
xOutItem.ReminderMinutesBeforeStart = xRg.Cells(i, 6).Value
Else
xOutItem.ReminderSet = False
End If
If Sheets("Follow up for Outlook Calendar").Range("H2").Value = "Region 1 - Matt" Then
xOutItem.Recipients.Add ("region1verizon@hydrants.com")
xOutItem.Recipients.Add ("masterverizoncellphone@hydrants.com")
Else

End If
If Sheets("Follow up for Outlook Calendar").Range("H2").Value = "Region 2 - Steve" Then
xOutItem.Recipients.Add ("region2verizon@hydrants.com")
xOutItem.Recipients.Add ("masterverizoncellphone@hydrants.com")
Else

End If
If Sheets("Follow up for Outlook Calendar").Range("H2").Value = "Region 3 - Chris Jones" Then
xOutItem.Recipients.Add ("region3verizon@hydrants.com")
xOutItem.Recipients.Add ("masterverizoncellphone@hydrants.com")
Else

End If
If Sheets("Follow up for Outlook Calendar").Range("H2").Value = "Region 4 - Dan M" Then
xOutItem.Recipients.Add ("region4verizon@hydrants.com")
xOutItem.Recipients.Add ("masterverizoncellphone@hydrants.com")
Else

End If

xOutItem.Body = xRg.Cells(i, 7).Value
xOutItem.SentOnBehalfOfName = XEmailAlias
xOutItem.Display
'xOutItem.Send
Set xOutItem = Nothing
Next
Set xOutApp = Nothing
End Sub

 

[MrHydrant1857]

ok so i just tested this by only sending an email and it worked. My issue is that i want to create a meeting not just a standard email.

 

[MrHydrant1857]

Also, another thought I had on this was to not send the invite from a specific account, but to have it not add the meeting invite to the organizers calendar. is this something that is possible??