VBScript to map additional mailboxes

[sinbad]

Hi, does anyone know how to create a VBScript that will map an additional
mailboxes, based on their AD group membership.

Just need the code to actually map the additional mailbox into their
Exchange profile.

Thank you

 

[Dmitry Streblechenko]

Do you mean add another delegate mailbox, the same thing you do through the
UI on the Advanced tab of fthe Exchange provider properties dialog?
1. Using Extended MAPi (cannot do that from a script or VB) - see
http://support.microsoft.com/?kbid=171636
2. Using Redemption - see RDOSession.AddDelegateExchangeMailbox;
http://www.dimastr.com/redemption/rdo/rdostores.htm#methods
3. If you want to add a delegate store to a profile that is not necessarily
active, you can use ProfMan -
http://www.dimastr.com/redemption/profiles.htm#example6

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

 

[sinbad]

Hi Dmitry,

Thank you for your help. This is exactly what I'm looking to do with a
Outlook 2003 client, and Exchange 2003.

I've tried editing your example script but as I'm quite new to scripting, I
wasn't sure what parts to amend. I would be most grateful if you could show
me which parts of the script to change, and how I run this onmy machine
please.

Profile is "Outlook", on server "Treebeard", and additional mailbox to be
added is "Spam".

Many thanks for all your help.

Regards
Sin

 

[Dmitry Streblechenko]

Try the script below:

strProfileName = "Outlook"

PR_STORE_PROVIDERS = &H3D000102
PR_PROVIDER_UID = &H300C0102
PR_DISPLAY_NAME = &H3001001E
PR_PROFILE_MAILBOX = &H660B001E
PR_PROFILE_SERVER = &H660C001E
PR_PROFILE_SERVER_DN = &H6614001E
PR_EMAIL_ADDRESS = &H3003001E

Sub AddMailBox(strProfile, strDisplayName, strMailboxDN, strServer,
strServerDN)
set Profiles=CreateObject("ProfMan.Profiles")
if strProfile = "" Then
set Profile = Profiles.DefaultProfile
Else
set Profile = Profiles.Item(strProfile)
End If
'find the Exchange service
set Services = Profile.Services
for i = 1 to Services.Count
set Service = Services.Item(i)
if Service.ServiceName = "MSEMS" Then
'Add "EMSDelegate" provider
set Properties = CreateObject("ProfMan.PropertyBag")
Properties.Add PR_DISPLAY_NAME, strDisplayName
Properties.Add PR_PROFILE_MAILBOX, strMailboxDN
Properties.Add PR_PROFILE_SERVER, strServer
Properties.Add PR_PROFILE_SERVER_DN, strServerDN
set Provider = Service.Providers.Add("EMSDelegate", Properties)
'update the old value of PR_STORE_PROVIDERS so that Outlook
'will show the mailbox in the list in Tools | Services
set GlobalProfSect = Profile.GlobalProfSect
OldProviders = GlobalProfSect.Item(PR_STORE_PROVIDERS)
strUID = Provider.UID
GlobalProfSect.Item(PR_STORE_PROVIDERS) = OldProviders & strUID
End If
Next
End Sub

'get PR_PROFILE_SERVER and PR_PROFILE_SERVER_DN
'It is assumed that the mailbox to add is on the same server as the current
user's mailbox
MAPI_STORE_PROVIDER = 33
set Profiles=CreateObject("ProfMan.Profiles")
set Profile = Profiles.Item(strProfileName)
set Services = Profile.Services
for i = 1 to Services.Count
set Service = Services.Item(i)
if Service.ServiceName = "MSEMS" Then
set Providers = Service.Providers
for j = 1 to Providers.Count
set Provider = Providers.Item(j)
if Provider.ResourceType = MAPI_STORE_PROVIDER Then
set ProfSect = Provider.ProfSect
strProfileServer = ProfSect.Item(PR_PROFILE_SERVER)
strProfileServerDN = ProfSect.Item(PR_PROFILE_SERVER_DN)
End If
Next
End If
Next

'Add the first GAL entry's mailbox to the default profile
set AddrEntry = CDOSession.AddressLists.Item("Global Address
List").AddressEntries.Item("Spam")
AddMailBox strProfileName, _
"Mailbox - " & AddrEntry.Fields(PR_DISPLAY_NAME).Value,
_
AddrEntry.Fields(PR_EMAIL_ADDRESS).Value, _
strProfileServer, _
strProfileServerDN

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool