I work for a large public University and we have many Resource Accounts. We needed a way to move from Public Folders but we wanted it to be seemless as possible. To do this, I created this VBS script that allows anyone to add Resource Accounts to their Outlook 2013/2010 calendar as a shared calendar. The user in question will have to run this script while Outlook is open and it will pull the Resource Account (add the Resource Account name in the RESOURCEACCOUNTNAME variable below) from the GAL and add it to the users calendar. I hope this helps anyone interested in doing the same.
'**************************************************************************
' Script Name: ADDCALENDAR.vbs
' Version: 1.0
' Author: Josh Rickard
'Last Updated: 4.Nov.2013
' Purpose: This program is used to add Room Resource Calendars to
' someones Microsoft Office 2013 Shared Calendars group.
' Outlook 2013 has to be open for this script to continue.
' This script was originally created for the Trulaske
' University of REDACTED Technology Services Department.
' Legal: Script provided "AS IS" without warranties or guarantees
' of any kind. USE AT YOUR OWN RISK. Public domain.
'**************************************************************************
Dim objApp
Dim objNS
Dim objFolder
Dim strName(3)
Dim objDummy
Dim objRecip
Dim calendar
strName(0) = "RESOURCEACCOUNTNAME"
strName(1) = "RESOURCEACCOUNTNAME"
strName(2) = "RESOURCEACCOUNTNAME"
strName(3) = "RESOURCEACCOUNTNAME"
Const olMailItem = 0
Const olFolderCalendar = 9
' This section checks to see if Outlook 2013 is open. If it is not
' It will return "Please Open Outlook and run this program again"
'Change "Outlook.Application.15" to "Outlook.Application.14" for Outlook 2010
On Error Resume Next
Dim Outlook: Set Outlook = GetObject(, "Outlook.Application.15")
If Err.Number = 0 Then
MsgBox "This program will add Room Calendars to your mailbox."
Else
MsgBox "Please Open Outlook and run this program again."
Err.Clear
End If
' For Each Next Loop while adds each calendar from strName(array) to the users Shared Calendars
For Each calendar In strName
Set objApp = CreateObject("Outlook.Application.15")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = Nothing
Set objDummy = objApp.CreateItem(olMailItem)
Set objRecip = objDummy.Recipients.Add(calendar)
objRecip.Resolve
If objRecip.Resolved = True Then
On Error Resume Next
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
On Error GoTo 0
Else
MsgBox "Could not find ", , _
"User not found"
End If
Next
Set GetOtherUserCalendar = objFolder
Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Advertisements
Hi, Josh.
With a couple of modifications, the script can start Outlook if it’s not already running and can be version independent (i.e. no need to modify the script based on yor ersion of Outlook). Something like this.
'************************************************************************** ' Script Name: ADDCALENDAR.vbs ' Version: 1.0 ' Author: Josh Rickard ' Last Updated: 4.Nov.2013 ' Purpose: This program is used to add Room Resource Calendars to ' someones Microsoft Office 2013 Shared Calendars group. ' Outlook 2013 has to be open for this script to continue. ' This script was originally created for the Trulaske ' University of REDACTED Technology Services Department. ' Legal: Script provided "AS IS" without warranties or guarantees ' of any kind. USE AT YOUR OWN RISK. Public domain. '************************************************************************** Dim objApp Dim objNS Dim objFolder Dim strName(3) Dim objDummy Dim objRecip Dim calendar strName(0) = "RESOURCEACCOUNTNAME" strName(1) = "RESOURCEACCOUNTNAME" strName(2) = "RESOURCEACCOUNTNAME" strName(3) = "RESOURCEACCOUNTNAME" Const olMailItem = 0 Const olFolderCalendar = 9 On Error Resume Next 'Get the open instance of Outlook, if there is one Set objApp = GetObject(, "Outlook.Application") 'Outlook was not open If TypeName(objApp) = "Nothing" Then 'Create an instance of Outlook Set objApp = CreateObject("Outlook.Application") Set objNS = objApp.GetNamespace("MAPI") 'Logon using the default Outlook profile name objNS.Logon objApp.DefaultProfileName Else Set objNS = objApp.Session End If On Error GoTo 0 ' For Each Next Loop while adds each calendar from strName(array) to the users Shared Calendars For Each calendar In strName Set objFolder = Nothing Set objDummy = objApp.CreateItem(olMailItem) Set objRecip = objDummy.Recipients.Add(calendar) objRecip.Resolve If objRecip.Resolved = True Then On Error Resume Next Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar) On Error GoTo 0 Else MsgBox "Could not find ", , _ "User not found" End If Next Set GetOtherUserCalendar = objFolder Set objApp = Nothing Set objNS = Nothing Set objFolder = NothingHi,
I keep on getting complier error about the last next thats before “Set GetOtherUserCalendar = objFolder”
Any insights?
Thanks
Jess, so sorry for not responding to your question sooner. If you’re still experiencing issues, please let me know. I’m not sure what you mean by “Compile error”. This should be in a .VBS script and not compiled in a compiler.
Is there a way to add a delegates mailbox to the user’s profile so that we he opens outlook he will see the delegate mailbox which they already have the send as permissions?
To automatically add a delegates mailbox to a user’s profile, you would first have to search AD and then authenticate as that user. This would more than likely be difficult; both the AD search and authentication portions.