Function CreateMailbox(sUserName,sJournalnavn,sDataCenter,sFirstName,sLastName,sErrorFile)
  On Error Resume Next
  CreateMailbox = True
'Strings, Integers & Variants
  Dim sMailServer,sOrganisation,sExchSite,sDomain,sADsPath
  Dim sADsAdmAcc,sADsAdmPsw,sGroupOrgArray
  Dim sAlias,sMTA,sMDB,sSMTPAddr,sDepartment
  Dim hSIDHex
'General Objects
  Dim oLogon        'Impersonation Object
  Dim oNameSpace    'NameSpace Context Object
  Dim oContainer    'LDAP Container Object
  Dim oMailBox        'LDAP User Object
  Dim oSID        'Security Identifier Object
  Dim oSec        'Security Object
'ADSI Objects
  Dim oSD        'Security Descriptor Object
  Dim oDACL        'Discretionary Access Control List Object
  Dim oACE        'Access Control Entry Object
'Constants
  Const ADS_ACETYPE_ACCESS_ALLOWED = 0
  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
'Exchangeserver, Organisation and Site information
  Select Case Mid(UCase(sDataCenter),1,3)
    Case "XXX"
      sMailServer = "XXXSRV01"
    Case "YYY"
      sMailServer = "YYYSRV01"
    Case "ZZZ"
      sMailServer = "ZZZSRV01"
  End Select
  sOrganisation = "ORGANISATION"
  sExchSite = "SITE"
  sDomain = "DOMAIN"
'Mailbox parameters buildup
  sAlias = sUserName
  sMTA = "cn=Microsoft MTA,cn=" & sMailServer & ",cn=Servers,cn=Configuration,ou=" & sExchSite & ",o=" & sOrganisation
  sMDB = "cn=Microsoft Private MDB,cn=" & sMailServer & ",cn=Servers,cn=Configuration,ou=" & sExchSite & ",o=" & sOrganisation
  If Len(Trim(sJournalnavn)) > 0 Then
    sSMTPAddr = sJournalnavn & "@customer.com"
  Else
    sSMTPAddr = sUserName & "@customer.com"
  End If
'Build Recipient container's adsPath, (i.e. LDAP://myserver/CN=Recipients, OU=Site, O=Org) and connect to the container
  sADsPath = "LDAP://" & sMailServer
  sADsPath = sADsPath & "/CN=Recipients,OU="
  sADsPath = sADsPath & sExchSite
  sADsPath = sADsPath & ",O="
  sADsPath = sADsPath & sOrganisation
  sADsAdmAcc = "DOMAIN\ExchangeServices"
  sADsAdmPsw = "******"
  Set oNameSpace = GetObject("LDAP:")
  If ErrorEvent("CreateMailbox::oNameSpace:GetObject",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  Set oContainer = oNameSpace.OpenDSObject(sADsPath,sADsAdmAcc,sADsAdmPsw,1)
  If ErrorEvent("CreateMailbox::oContainer:oNameSpace.OpenDSObject",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
'get users organisational relations (institution,afdeling,sektion)
  sGroupOrgArray = GetGroupOrgStrArray(sAlias,"dc=domain,dc=com",";")
'create a new mailbox and apply the attributes
  Set oMailBox = oContainer.Create("organizationalPerson", "cn=" & sAlias)
  If ErrorEvent("CreateMailbox::oContainer.Create",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  oMailBox.Put "mailPreferenceOption", 0
  oMailBox.Put "givenName", sFirstName
  oMailBox.Put "sn", sLastName
  oMailBox.Put "cn", sLastName & " " & sFirstName
'DebugError("sGroupOrgArray(1):[" & GetWordFromString(sGroupOrgArray,1,";") & "]")
'DebugError("sGroupOrgArray(2):[" & GetWordFromString(sGroupOrgArray,2,";") & "]")
'DebugError("sGroupOrgArray(3):[" & GetWordFromString(sGroupOrgArray,3,";") & "]")
  If GetWordFromString(sGroupOrgArray,1,";") <> "" Then
    oMailBox.Put "Company", GetWordFromString(sGroupOrgArray,1,";")
  End If
  If GetWordFromString(sGroupOrgArray,2,";") <> "" Then
    oMailBox.Put "Department", GetWordFromString(sGroupOrgArray,2,";")
  End If
  'oMailBox.Put "Physical-Delivery-Office-Name", GetWordFromString(sGroupOrgArray,3,";")
  oMailBox.Put "uid", sAlias
  oMailBox.Put "Home-MTA", sMTA
  oMailBox.Put "Home-MDB", sMDB
  oMailBox.Put "textencodedORaddress", "c=com;a=XX400;p=ORGANIZATION;o=" & sExchSite & ";s=" & sAlias & ";"
  oMailBox.Put "mail", sSMTPAddr
  oMailBox.Put "MAPI-Recipient", True
  oMailBox.Put "rfc822Mailbox", sSMTPAddr
'commit the property cache to the directory service
  oMailBox.SetInfo
  If ErrorEvent("CreateMailbox::oMailBox.SetInfo:Put",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
'associating to a primary account (ADSSECURITY.DLL)
  Set oSID = CreateObject("ADsSID")
  If ErrorEvent("CreateMailbox::oSID:CreateObject",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  oSID.SetAs ADS_SID_WINNT_PATH, "WinNT://" & sDomain & "/" & sAlias & ",user"
  If ErrorEvent("CreateMailbox::oSID.SetAs",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  hSIDHex = oSID.GetAs(ADS_SID_HEXSTRING)
  If ErrorEvent("CreateMailbox::oSID.GetAs",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  oMailBox.Put "Assoc-NT-Account", hSIDHex
'commit the property cache to the directory service
  oMailBox.SetInfo
  If ErrorEvent("CreateMailbox::oMailBox.SetInfo:Assoc-NT-Account",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
'apply the mailbox security to allow the user to modify a user attribute, send and receive mail
  Set oSec = CreateObject("ADsSecurity")
  If ErrorEvent("CreateMailbox::oSec:CreateObject",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  Set oSD = oSec.GetSecurityDescriptor(oMailBox.ADsPath)
  If ErrorEvent("CreateMailbox::oSD:oSec.GetSecurityDescriptor",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  Set oDACL = oSD.DiscretionaryAcl
  If ErrorEvent("CreateMailbox::oDACL:oSD.DiscretionaryAcl",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  Set oACE = CreateObject("AccessControlEntry")
  If ErrorEvent("CreateMailbox::oACE:CreateObject",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  oACE.Trustee = sDomain & "\" & sAlias
  If ErrorEvent("CreateMailbox::oACE.Trustee",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  oACE.AccessMask = ADS_RIGHT_EXCH_MODIFY_USER_ATT Or ADS_RIGHT_EXCH_MAIL_SEND_AS Or ADS_RIGHT_EXCH_MAIL_RECEIVE_AS
  If ErrorEvent("CreateMailbox::oACE.AccessMask",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  oACE.ACEType = ADS_ACETYPE_ACCESS_ALLOWED
  If ErrorEvent("CreateMailbox::oACE.ACEType",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  oDACL.AddAce oACE
  If ErrorEvent("CreateMailbox::oDACL.AddAce",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  oSD.DiscretionaryAcl = oDACL
  If ErrorEvent("CreateMailbox::oSD.DiscretionaryAcl",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
  oSec.SetSecurityDescriptor oSD
  If ErrorEvent("CreateMailbox::oSec.SetSecurityDescriptor",sErrorFile) Then
    CreateMailbox = False
    Exit Function
  End If
'close all objects and exit
  Set oLogon = Nothing
  Set oContainer = Nothing
  Set oMailBox = Nothing
  Set oSID = Nothing
  Set oSec = Nothing
  Set oSD = Nothing
  Set oDACL = Nothing
  Set oACE = Nothing
  On Error Goto 0
End Function