VBS : Созадть Почтовый ящик для пользователя

Dim oIADSUser
Dim oMailbox

Set oIADS = GetObject("LDAP://RootDSE")
strDefaultNC = oIADS.Get("defaultnamingcontext")
MsgBox FindAnyMDB("CN=Configuration," & strDefaultNC)

'TODO: Use the newly created domain user account to replace the "UserName".
Set oIADSUser = GetObject("LDAP://CN=dsa,CN=Users," & strDefaultNC)

If oIADSUser Is Nothing then
    MsgBox "The oIADSUser is Nothing."
Else
    MsgBox "The oIADSUser is created successfully."
End If

Set oMailBox = oIADSUser
oMailbox.CreateMailbox FindAnyMDB("CN=Configuration," & strDefaultNC)
oIADSUser.SetInfo

Function FindAnyMDB(strConfigurationNC)
    Dim oConnection
    Dim oCommand
    Dim oRecordSet
    Dim strQuery

    ' Open the Connection.
    Set oConnection = CreateObject("ADODB.Connection")
    set oCommand = CreateObject("ADODB.Command")
    Set oRecordSet = CreateObject("ADODB.Recordset")

    oConnection.Provider = "ADsDSOObject"
    oConnection.Open "ADs Provider"

    ' Build the query to find the private MDB.
    strQuery = "<LDAP://" & strConfigurationNC & ">;(objectCategory=msExchPrivateMDB);name,adspath;subtree"

    oCommand.ActiveConnection = oConnection
    oCommand.CommandText = strQuery

Set oRecordSet = oCommand.Execute

    ' If you have an MDB, return the first one.
    If Not oRecordSet.EOF Then
        oRecordSet.MoveFirst
        FindAnyMDB = CStr(oRecordSet.Fields("ADsPath").Value)
    Else
        FindAnyMDB = ""
    End If


    'Clean up.
    oRecordSet.Close
    oConnection.Close
    Set oRecordSet = Nothing
    Set oCommand = Nothing
    Set oConnection = Nothing
End Function