Script: Adding Exchange Resource Accounts to your Outlook

'**************************************************************************
' 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

5 thoughts on “Script: Adding Exchange Resource Accounts to your Outlook”

1. 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 = Nothing
   

   Reply

2. Hi,

   I keep on getting complier error about the last next thats before “Set GetOtherUserCalendar = objFolder”

   Any insights?

   Thanks

   Reply

   1. 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.

      Reply

3. 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?

   Reply

   1. 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.

      Reply