Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Outlook / Programming VBA / August 2006

Tip: Looking for answers? Try searching our database.

VBScript to map additional mailboxes

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
sinbad - 29 Aug 2006 01:49 GMT
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 - 29 Aug 2006 18:25 GMT
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

> Hi, does anyone know how to create a VBScript that will map an additional
> mailboxes, based on their AD group membership.
[quoted text clipped - 3 lines]
>
> Thank you
sinbad - 30 Aug 2006 17:36 GMT
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

> 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?
[quoted text clipped - 18 lines]
> >
> > Thank you
Dmitry Streblechenko - 31 Aug 2006 18:02 GMT
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

> Hi Dmitry,
>
[quoted text clipped - 41 lines]
>> >
>> > Thank you
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.