Creating New Email Account in Exchange 2003 via VBA

Home Forums Messaging Software Exchange 2000 / 2003 Creating New Email Account in Exchange 2003 via VBA

This topic contains 0 replies, has 1 voice, and was last updated by Avatar TxGeekGirl 7 years, 8 months ago.

Viewing 1 post (of 1 total)
  • Author
    Posts
  • Avatar
    TxGeekGirl
    Member
    #156067

    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!!!

    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

    [/CODE][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

    [/CODE]

Viewing 1 post (of 1 total)

You must be logged in to reply to this topic.