Announcement

Collapse
No announcement yet.

Creating New Email Account in Exchange 2003 via VBA

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Creating New Email Account in Exchange 2003 via VBA

    Hi All - I have a DB for supervisors to use when they hire a new employee. One thing we would like the IS Clerk to do after she has reviewed the info is to be able to click a button and have it create our user with email box.

    I have the code tweaked to create the User, assign info/pwd, and add to groups. I am so close to the email part - but coming up with Obj doesn't exist in LDAP. HELP!

    I am posting entire code - Create Mailbox is at end. Thanks in advance!!!

    Code:
    Public Function CreateAdAccount(sPassword, sFirstName, sLastName, sGroupName) As Boolean
        CreateAdAccount = True
        Dim oMailbox As CDOEXM.IMailboxStore
        Dim oUser As IADsUser
        Set RootDSE = GetObject("ldap://RootDSE")
        DomainContainer = RootDSE.Get("defaultNamingContext")
        Set oOU = GetObject("ldap://CN=Users;DC=pbcc,DC=com")
     
        ID = DLookup("StaffID", "NewStaffRequests", "ID = " & myRec)
        gname = Trim(sFirstName)
        sname = Trim(sLastName)
        FullName = gname & " " & sname
        Alias = LCase(Left(gname, 1) & sname)
     
        ' Test for existing alias name
        'Set conn = CreateObject("ADODB.Connection")
        'conn.Provider = "ADSDSOObject"
        'conn.Open "ADs Provider"
    '    ldapStr = ";(&(objectCategory=user)(mailNickname=" & Alias & "));adspath;subtree"
        'ldapStr = ";(&(objectCategory=user)(mail=" & Alias & "));adspath;subtree"
        'Set rs = conn.Execute(ldapStr)
     
        'MsgBox "Matching Names Count = " & Str(rs.RecordCount)
     
        'If rs.RecordCount > 0 Then
            'MsgBox "User email alias already exists!"
        'End If
     
        ' Update User Record
        Set oUser = oOU.Create("user", "cn=" & FullName)
        oUser.Put "cn", FullName
        oUser.Put "SamAccountName", FullName
        oUser.Put "userPrincipalName", FullName & "@pbcc.com"
        oUser.Put "givenName", gname
        oUser.Put "sn", sname
        oUser.Put "mail", Alias & "@pbcc.com"
        oUser.Put "description", ID
        oUser.Put "ScriptPath", "Wlogic.bat"
     
        oUser.SetInfo
        oUser.GetInfo
        ' Enable Account
        oUser.AccountDisabled = False
        ' Set Pwd to be same as 123456
        oUser.SetPassword (sPassword)
        'Account is not disabled
        oUser.AccountDisabled = False
        ' User must change password at next Logon
        oUser.Put "pwdLastSet", CLng(0)
        oUser.SetInfo
     
        ' Add the user to a group
        Dim index As Integer
        Dim sEachGroup As String
     
        Do While Len(sGroupName) > 0
            'End of list - can't have a string going from 1 to 0
            If InStr(sGroupName, ",") <> 0 Then
                index = InStr(sGroupName, ",")
            Else
                index = 50
            End If
     
            sEachGroup = Mid(sGroupName, 1, index - 1)
            MsgBox (sEachGroup)
     
            StrobjGroup1 = "ldap://cn=" & sEachGroup & ",cn=Users,DC=pbmhmr,DC=com"
            Set objGroup1 = GetObject(StrobjGroup1)
            objGroup1.Add (oUser.ADsPath)
     
            sGroupName = Mid(sGroupName, index + 1)
        Loop
     
        ' Create Mailbox
       Set oMailbox = oUser
       MDBName = "Mailbox Store (EXCH_CENTER)"
       StorageGroup = "First Storage Group"
       Server = "EXCH_CENTER"
       AdminGroup = "First Administrative Group"
       Organization = "PBCC (Exchange)"
       DomainDN = "DC=pbcc,DC=com"
        oMailbox.CreateMailbox "ldap://CN=Mailboxes,CN=" & MDBName & _
        ",CN=" & StorageGroup & _
        ",CN=" & Server & _
        ",CN=Servers" & _
        ",CN=" & AdminGroup & _
        ",CN=Administrative Groups" & _
        ",CN=" & Organization & _
        "," & DomainDN
     
        oUser.SetInfo
     
        '",CN=InformationStore" & _
        'CN=Configuration,
        '",CN=Microsoft Exchange,CN=Services" & _
     
        ' Cleanup
        Set oUser = Nothing
     
    End Function
    Last edited by TxGeekGirl; 2nd September 2011, 22:22.
Working...
X