Click here to Skip to main content
15,889,403 members
Articles / Programming Languages / VBScript
Article

Check if a user has an Exchange mailbox

Rate me:
Please Sign up or sign in to vote.
4.00/5 (2 votes)
23 Sep 2003 155.2K   24   19
Check in a command file if a user has an exchange mailbox

Introduction

This VBScript is used to check if a user has an exchange mailbox. The result is the Errorlevel variable which will be set. This script can be called in a command file. For example, you could run outlook only if the user has a mailbox.

Solution

The solution is to check if there is Exchange information in active directory for this user.
As you can see, the username (logonname) is optional. In case you do not give the username, then the name will be taken from the environment variable USERNAME.

In a command file (e.g. Logon script) it is sufficient to call this script and to check the Errorlevel.
REM *** Run Outlook when user has an exchange account ***
HasMailBox.vbs
If not errorlevel==1 outlook.exe

Change the Domain Controller information, replace MyMainDC with the domain controller you want to query. (LDAP)

DCServer = "MyMainDC"

VBScript
'***********************************************
'
' HasMailbox.vbs
' (c) 2003 Computech 
' Written by Peter Verijke
' Checks is user has a mailbox in Exchange
'
' Usage : HasMailbox [LogonName]
' Returns : Errorlevel==1 : not found
'
'***********************************************
 

Dim ArgObj
Dim WshShell ' as object
Dim objEnv ' as collection
Dim objUser 'As IADsUser
Dim objMailbox 'As CDOEXM.IMailboxStore
Dim sUserLDAPName 'As String
Dim DCServer 'As String

 

' Get the Arguments object
Set ArgObj = WScript.Arguments

 

If ArgObj.Count < 1 Then
   Set WshShell = WScript.CreateObject("WScript.Shell")
   Set objEnv = WshShell.Environment("PROCESS")

 

   sUserName = objEnv("USERNAME")
else
   sUserName = UCase(ArgObj(0))
End If

 

DCServer = "MyMainDC"
sUserLDAPName = QueryActiveDirectory(sUserName)

 

Set objUser = GetObject("LDAP://" & DCServer + "/" & sUserLDAPName)

Set objMailbox = objUser
'check if user is mailbox enabled
If objMailbox.HomeMDB = "" Then
   WScript.Quit 1
Else
   WScript.Quit 0
End If

 


Public Function QueryActiveDirectory(sUserName)
'Function:      QueryActiveDirectory
'Purpose:       Search the Active Directory's Global Catalog for users
'Parameters:    UserName - user to search for
'Return:        The user's distinguished name
 
    Dim oAD 'As IADs
    Dim oGlobalCatalog 'As IADs
    Dim oRecordSet 'As Recordset
    Dim oConnection 'As New Connection
    Dim strADsPath 'As String
    Dim strQuery 'As String
    Dim strUPN 'As String

 

    set oRecordSet = CreateObject("ADODB.Recordset")
    set oConnection = CreateObject("ADODB.Connection")

 

    'Determine the global catalog path
    Set oAD = GetObject("GC:")
    For Each oGlobalCatalog In oAD
        strADsPath = oGlobalCatalog.AdsPath
    Next
    'Initialize the ADO object
    oConnection.Provider = "ADsDSOObject"
    'The ADSI OLE-DB provider
    oConnection.Open "ADs Provider"
    'Create the search string
    strQuery = "<" & strADsPath & _
      ">;(&(objectClass=user)(objectCategory=person)(samaccountName=" & _
      sUserName & "));userPrincipalName,cn,distinguishedName;subtree"  
        'Execute the query

    Set oRecordSet = oConnection.Execute(strQuery)
    If oRecordSet.EOF And oRecordSet.BOF Then    
       'An empty recordset was returned
        QueryActiveDirectory = "Not Found"
    Else    'Records were found; loop through them
        While Not oRecordSet.EOF
            QueryActiveDirectory = oRecordSet.Fields("distinguishedName")
            oRecordSet.MoveNext
        Wend
    End If
End Function

License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here


Written By
Founder Computech bvba
Belgium Belgium
I´m a freelance ICT consultant and Technical Project Manager for the last 15 years already.
Before that, I was a Software Developer for the Pharmaceutical and Petrochemical industry.
I developed a very wide knowledge in the ICT world due to my intrest.
This includes Networking (Lan, Wan), Routing Switching Bridging, etc...
Windows environment, which has no secrets for me.
Developing: To many languages to mension here.
Of course, the latest one on the list is dot net.

Comments and Discussions

 
Questionhow to apply this code in Microsoft Script Editor Pin
tatminglee20-Jul-06 18:27
tatminglee20-Jul-06 18:27 
GeneralMonitor an Exchange Mailbox for replies Pin
gyzmo7120-Jul-06 8:25
gyzmo7120-Jul-06 8:25 
GeneralNo output or HasMailbox.vbs(47, 1) (null): An invalid dn syntax has been specified. Pin
TopCatt16-May-06 1:21
TopCatt16-May-06 1:21 
GeneralRe: No output or HasMailbox.vbs(47, 1) (null): An invalid dn syntax has been specified. Pin
Peter Verijke16-May-06 1:51
Peter Verijke16-May-06 1:51 
GeneralRe: No output or HasMailbox.vbs(47, 1) (null): An invalid dn syntax has been specified. Pin
TopCatt16-May-06 2:36
TopCatt16-May-06 2:36 
GeneralRe: No output or HasMailbox.vbs(47, 1) (null): An invalid dn syntax has been specified. Pin
Peter Verijke16-May-06 5:45
Peter Verijke16-May-06 5:45 
GeneralDeleting redundant SMTP addresses Pin
Member 143233011-Oct-04 18:58
Member 143233011-Oct-04 18:58 
GeneralRe: Deleting redundant SMTP addresses Pin
Peter Verijke13-Oct-04 5:58
Peter Verijke13-Oct-04 5:58 
Hi,

What you are suggesting needs some mayor knowledge of VBScript LDAP, CDOEX and ADSI. Frown | :(
I suggest to make this in dot net or in VB6.
The debugging will be very difficult is VBScripts.
What I always do, if a VBscripts is needed for some reason, then I code in VBA (Excel for example), and then I adapt the code to VBScript.
I can assure you that this is no begginners stuff. I also suggest to do this in a test domain first, because of the danger altering wron AD entries which could screw up your whole domain.

As a little help I will add some code I used to create users and e-mail addresses in some old VB6 software. Soon I will be making something simular in C# for one of my customers, so maybe I will publish an article about it.
Anyway, here some code wich could point you in the right direction.
This is not complete code, because some library's are called.
Also use ldp or some other LDAP tool, to get exact path to the OU or other AD objects.

P.S. You will learn a lot doing stuf like this. Wink | ;)

Kind Regards
Peter Verijke

<snip>
Const DesktopUser = 1
Const TSUser = 2

Public OU As String 'e.g. OU=xxxx, OU=xxxx, OU=xxxxx,DC=domain,DC=toplevel
Public FirstName
Public LastName
Public DisplayName
Public Description
Public Initials
Public samAccountName
Public userPrincipalName 'xxxxx@xxxx.xxx
Public Title
Public Department
Public TelephoneNumber
Public Password
Public Mail 'xxxxx@xxxx.xxx
Public MailNickName
Public Name
Public LoginScript
Public HomeDirectory
Public HomeDrive
Public ProfilePath
'Public ScriptPath
Public UserType As Integer 'Bit 1=NT, 2=TS
Public CreateMailbox As Boolean

Public Sub CreateUser()
Dim oComputer As IADsComputer
Dim oIADs As IADs
Dim oUser As IADsUser
Dim oShare As IADs
Dim oContainer As IADsContainer
Dim oGroup As IADsGroup
Dim oMailbox As CDOEXM.IMailboxStore
Set oContainer = GetObject("LDAP://" & OU)
Set oUser = oContainer.Create("user", "CN=" & samAccountName)
oUser.Put "samAccountName", samAccountName
oUser.Put "userPrincipalName", userPrincipalName
oUser.SetInfo

PutAttrib oUser, "title", Title
PutAttrib oUser, "givenName", FirstName
PutAttrib oUser, "sn", LastName
PutAttrib oUser, "displayName", DisplayName
PutAttrib oUser, "initials", Initials
PutAttrib oUser, "description", Description
PutAttrib oUser, "telephoneNumber", TelephoneNumber
PutAttrib oUser, "title", Title
PutAttrib oUser, "Department", Department
If Len(MailNickName) > 0 Then
PutAttrib oUser, "mail", Mail
PutAttrib oUser, "mailNickName", MailNickName
End If
PutAttrib oUser, "Name", Name
PutAttrib oUser, "LoginScript", LoginScript
'PutAttrib oUser, "ScriptPath", ScriptPath
If (UserType And DesktopUser) = DesktopUser Then
PutAttrib oUser, "HomeDirectory", HomeDirectory
PutAttrib oUser, "homeDrive", HomeDrive
PutAttrib oUser, "ProfilePath", ProfilePath
End If

oUser.SetInfo

'Set oUser = GetObject("WinNT://<DOMAIN>/" & samAccountName & ",user")

oUser.SetPassword (Password)
oUser.AccountDisabled = False

If CreateMailbox Then
Set oMailbox = oUser
'Create a mailbox for the recipient
'You cannot create a mailbox using ADSI, so use CDOEXM
'These values will differ for other organizations
'oMailbox.CreateMailbox "LDAP://" & DCServer & _
"/CN=Mailbox Store (" & _
DCServer & _
"),CN=First Storage Group,CN=InformationStore,CN=" & _
DCServer & _
",CN=Servers,CN=xxxx," & _
"CN=xxx,CN=xx," & _
"CN=Microsoft Exchange,CN=Services," & _
"CN=Configuration," & GetSingleXMLVar("DomainDN")
'oMailbox.CreateMailbox "LDAP://" + "SHFDK01" + _
"/CN=Private Information Store (SHFDK05)" + _
",CN=First Storage Group,CN=InformationStore,CN=" + _
"<EXCHANGESERVER>" & _
",CN=Servers,CN=xxxx," & _
"CN=xxxxxx,CN=xxx," & _
"CN=Microsoft Exchange,CN=Services," & _
"CN=Configuration," & "DC=xxxxxxxx,DC=xxx"
oMailbox.CreateMailbox GetSingleXMLVar("MailStore")
'CreateADSImailbox
End If
oUser.SetInfo
If (UserType And TSUser) = TSUser Then
SetAllowLogonTerminalServer CStr(samAccountName), GetSingleXMLVar("Domain"), True
SetTerminalServerProfilePath CStr(samAccountName), GetSingleXMLVar("Domain"), CStr(ProfilePath)
SetTerminalServerHomeDirDrive CStr(samAccountName), GetSingleXMLVar("Domain"), CStr(HomeDrive)
SetTerminalServerHomeDir CStr(samAccountName), GetSingleXMLVar("Domain"), CStr(HomeDirectory)
Else
SetAllowLogonTerminalServer CStr(samAccountName), GetSingleXMLVar("Domain"), False
End If

Set oUser = Nothing
End Sub

Private Sub PutAttrib(ByRef oUser As IADsUser, sAttrib As String, vParameter)
If Not IsEmpty(vParameter) Then
If Len(vParameter) > 0 Then Call oUser.Put(sAttrib, vParameter)
End If
End Sub

Sub CDOCreateMailBoxRecipient(ServerName As String, _
domainname As String, _
emailname As String, _
FirstName As String, _
LastName As String)

'Dim objPerson As New CDO.Person
Dim objMailbox As CDOEXM.IMailboxStore

objPerson.FirstName = FirstName
objPerson.LastName = LastName
objPerson.Fields("userPrincipalName") = LastName

objPerson.Fields("userAccountControl") = 512
objPerson.Fields("userPassword") = "password"
objPerson.Fields.Update

objPerson.DataSource.SaveTo "LDAP://" + ServerName + _
"/CN=" + emailname + _
",CN=users," + domainname

Set objMailbox = objPerson

tempstr = "LDAP://" + ServerName + _
"/CN=newmailboxstore" + _
",CN=First Storage Group,CN=InformationStore,CN=" + _
ServerName + _
",CN=Servers,CN=First Administrative Group," + _
"CN=Administrative Groups,CN=First Organization," + _
"CN=Microsoft Exchange,CN=Services," + _
"CN=Configuration," + domainname

objMailbox.CreateMailbox tempstr

objPerson.DataSource.Save

End Sub

Private Sub CreateADSImailbox()
'--------------------------------------------------------
' Security object for SD manipulation
' (REQUIRED ADSI TOOL KIT - REGSVR32 ADSSECURITY.DLL)
'---------------------------------------------------------
Dim sid As New ADsSID 'You can also use -- Set sid = CreateObject("ADsSID") for late binding
Dim sec As New ADsSecurity 'You can also use -- Set sec = CreateObject("ADsSecurity") for late binding

'-------------------------------------
' The rest uses ADSI Interfaces
'-------------------------------------
Dim sd As IADsSecurityDescriptor
Dim dacl As IADsAccessControlList
Dim ace As New AccessControlEntry

'-------------------------------------------------------------------------
' If you don't include the ADSI Security Type Library as you make references,
' you must manually declare the following constants.
'-------------------------------------------------------------------------
Const ADS_SID_HEXSTRING = 1
Const ADS_SID_WINNT_PATH = 5
Const ADS_RIGHT_EXCH_MODIFY_USER_ATT = &H2
Const ADS_RIGHT_EXCH_MAIL_SEND_AS = &H8
Const ADS_RIGHT_EXCH_MAIL_RECEIVE_AS = &H10

'--------------------------------------------------------
'---------------CREATING A MAILBOX ----------------------
'--------------------------------------------------------

'--- Server, Org and Site information ---
server = "xxxxx"
Org = "xxxx"
Site = "xxxx"
Domain = "xxxx"

'--- MailBox Parameters ---
strAlias = samAccountName
strMTA = "cn=Microsoft MTA,cn=" & server & ",cn=Servers,cn=Configuration,ou=" & Site & ",o=" & Org
strMDB = "cn=Microsoft Private MDB,cn=" & server & ",cn=Servers,cn=Configuration,ou=" & Site & ",o=" & Org

'--- Creating a user to be associated with the mailbox---
'Set dom = GetObject("WinNT://" & Domain)
'Set usr = dom.Create("user", samAccountName)
'usr.SetInfo
'usr.SetPassword Password

'---------------------------------------------------------------
' Build Recipient container's adsPath:
' LDAP://myserver/CN=Recipients, OU=Site, O=Org
'---------------------------------------------------------------
ADsPath = "LDAP://" + server
ADsPath = ADsPath + "/cn=Recipients,OU="
ADsPath = ADsPath + Site
ADsPath = ADsPath + ",O="
ADsPath = ADsPath + Org

Set objCont = GetObject(ADsPath)

'---Create a new MailBox---
Set Mailbox = objCont.Create("organizationalPerson", "cn=" & strAlias)
Mailbox.Put "mailPreferenceOption", 0
Mailbox.Put "givenName", FirstName
Mailbox.Put "sn", LastName
Mailbox.Put "cn", DisplayName
Mailbox.Put "uid", strAlias
Mailbox.Put "Home-MTA", strMTA
Mailbox.Put "Home-MDB", strMDB
Mailbox.Put "mail", Mail
Mailbox.Put "MAPI-Recipient", True
Mailbox.Put "TextEncodedORaddress", "c=" & "nl" & ";a= " & ";p=" & Org & ";o=" & Site & ";s=" & LastName & ";g=" & FirstName & ";i=" & Initials & ";"
Mailbox.Put "rfc822Mailbox", Mail

'--------------------------------------------------------
' Associating to a primary account
' (Requires the ADSI tool kit - REGSVR32 ADSSECURITY.DLL )
'--------------------------------------------------------
sid.SetAs ADS_SID_WINNT_PATH, "WinNT://" & Domain & "/" & strAlias & ",user"
sidHex = sid.GetAs(ADS_SID_HEXSTRING)
Mailbox.Put "Assoc-NT-Account", sidHex

' Commit the property cache to the directory service
Mailbox.SetInfo

'-------------------------------------------------
' Set the mailbox security
' to allow the user to modify a user attribute,
' send mail, and receive mail
'-------------------------------------------------
Set sd = sec.GetSecurityDescriptor(Mailbox.ADsPath)
Set dacl = sd.DiscretionaryAcl
ace.Trustee = Domain & "\" & strAlias
ace.AccessMask = ADS_RIGHT_EXCH_MODIFY_USER_ATT Or ADS_RIGHT_EXCH_MAIL_SEND_AS Or ADS_RIGHT_EXCH_MAIL_RECEIVE_AS
ace.AceType = ADS_ACETYPE_ACCESS_ALLOWED
dacl.AddAce ace
sd.DiscretionaryAcl = dacl
sec.SetSecurityDescriptor sd

End Sub

<snip>
GeneralRe: Deleting redundant SMTP addresses Pin
Peter Verijke13-Oct-04 14:03
Peter Verijke13-Oct-04 14:03 
GeneralModifying attribute value Pin
Member 110700610-May-04 7:55
Member 110700610-May-04 7:55 
GeneralRe: Modifying attribute value Pin
Anonymous13-May-04 3:45
Anonymous13-May-04 3:45 
GeneralExchange Server Settings Pin
RPA26-Sep-03 15:10
RPA26-Sep-03 15:10 
QuestionMail retrieval? Pin
totig24-Sep-03 22:59
totig24-Sep-03 22:59 
AnswerRe: Mail retrieval? Pin
Peter Verijke24-Sep-03 23:36
Peter Verijke24-Sep-03 23:36 
GeneralRe: Mail retrieval? Pin
totig25-Sep-03 1:47
totig25-Sep-03 1:47 
GeneralRe: Mail retrieval? Pin
Anonymous26-Sep-03 5:51
Anonymous26-Sep-03 5:51 
QuestionRe: Mail retrieval without pop3? Pin
MFMan75826-Sep-07 4:25
MFMan75826-Sep-07 4:25 
GeneralRe: Mail retrieval? Pin
#teve26-Sep-03 5:24
#teve26-Sep-03 5:24 
GeneralRe: Mail retrieval? Pin
Peter Verijke26-Sep-03 5:57
Peter Verijke26-Sep-03 5:57 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.