Announcement

Collapse
No announcement yet.

Create Exchange 2003 Mailbox

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

  • Create Exchange 2003 Mailbox

    I was wondering if someone could help me out with this...I'm completely stumped as to why this code isn't working. I double checked all my settings and I have the right information.

    I have this code integrated into a bulk import of users from excel. The problem I come across, is nothing happens with the mailbox. The user and all their information gets imported with no problem, but no error messages appear stating that their was an issue creating the mailbox.

    Am I missing something here? Thanks.

    *Mailbox code is in blue


    Code:
    Const ForAppending = 8
    
    Dim objUser, objMailbox
    
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("C:\test.xls")
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strLogFile = "C:\log.txt"
    Set objLog = objFSO.CreateTextFile(strLogFile, ForAppending)
    
    strPassword = "test12345"
    intPwdValue = 0
    intRow = 2
    
    strTargetOU = "ou=test,dc=domain,dc=com"
    
    Do Until objExcel.Cells(intRow,1).Value = ""
    
        strDN = Trim(objExcel.Cells(intRow, 1).Value)
        strTelephone = Trim(objExcel.Cells(intRow, 2).Value)
        strCompany = Trim(objExcel.Cells(intRow, 3).Value)
        strDepartment = Trim(objExcel.Cells(intRow, 4).Value)
        strMail = Trim(objExcel.Cells(intRow, 5).Value)
        strFirst = Trim(objExcel.Cells(intRow, 6).Value)
        strTitle = Trim(objExcel.Cells(intRow, 7).Value)
        strLast = Trim(objExcel.Cells(intRow, 8).Value)
        strFirstInitial = Left(strFirst,1) 
        strSAMAccountName = strFirstInitial & strLast
        If (strFirst <> "") AND (strLast <> "") Then
           strCN = strLast & "\, " & strFirst
        Else
           strCN = strSAMAccountName
        End If
        strDisplayName = strLast & ", " & strFirst
        strUPN = strSAMAccountName & "@domain.com"
    
        On Error Resume Next
        Set objTargetOU = GetObject("LDAP://" & strTargetOU)
        If (Err.Number <> 0) Then
           On Error GoTo 0
           WScript.Echo "Unable to bind to target OU: " & strTargetOU
           WScript.Quit
        End If
    
        On Error Resume Next
        Set objUser = objTargetOU.Create("user", "cn=" & strCN)
        If (Err.Number <> 0) Then
           On Error GoTo 0
           objLog.WriteLine Now & vbTab & "FAILED TO CREATE USER with cn: " & strDisplayName
        Else
              objUser.sAMAccountName = strSAMAccountName
              objUser.displayName = strDisplayName
    
              On Error Resume Next
              objUser.SetInfo
              If (Err.Number = "-2147019886") Then
                 On Error GoTo 0
                 objLog.WriteLine Now & vbTab & "FAILED TO CREATE (user already exists!): " & strDisplayName
              ElseIf (Err.Number <> 0) Then
                 On Error GoTo 0
                 objLog.WriteLine Now & vbTab & "FAILED TO CREATE (" & Err.number & ") :" & strDisplayName
              Else
                 objUser.SetPassword strPassword
                 objUser.pwdLastSet = intPwdValue
                 objUser.AccountDisabled = FALSE
                 objUser.UserPrincipalName = strUPN
                 If (strTelephone <> "") Then
                    objUser.telephoneNumber = strTelephone
                 End If
                 If (strCompany <> "") Then
                    objUser.company = strCompany
                 End If
                 If (strDepartment <> "") Then
                    objUser.department = strDepartment
                 End If
                 If (strMail <> "") Then
                    objUser.mail = strMail
                 End If
                 If (strFirst <> "") Then
                    objUser.GivenName = strFirst
                 End If
                 If (strTitle <> "") Then
                    objUser.title = strTitle
                 End If
                 If (strLast <> "") Then
                    objUser.SN = strLast
                 End If
    
                 CreateMailbox "Mailbox Store (DEFAULT1)","First Storage Group", "SERVER", _
                               "ADMIN GROUP","COMPANY"
    
                 On Error Resume Next
                 objUser.SetInfo
                 If (Err.Number <> 0) Then
                    On Error GoTo 0
                    objLog.WriteLine Now & vbTab & "FAILED TO CREATE (" & Err.number & ") :" & strDisplayName
                 End If
                 On Error GoTo 0
    
                 objLog.WriteLine Now & vbTab & "SUCCESSFULLY CREATED: " & strDisplayName
    
              End If
        End If
    
        intRow = intRow + 1
    Loop
    
    objExcel.Quit
    objLog.Close
    
    Sub CreateMailBox _
      (strMDBName,strStorageGroup,strServer,strAdminGroup,strOrganization)
        Set objMailbox = objUser
           objMailbox.CreateMailbox "LDAP://CN=" & strMDBName & _
              ",CN=" & strStorageGroup & _
              ",CN=InformationStore" & _
              ",CN=" & strServer & _
              ",CN=Servers" & _
              ",CN=" & strAdminGroup & _
              ",CN=Administrative Groups" & _
              ",CN=" & strOrganization & _
              ",CN=Microsoft Exchange,CN=Services" & _
              ",CN=Configuration," & _
              ",DC=domain," & _
              ",DC=com"
    End Sub
    
    WScript.Echo "Import Complete!"
    WScript.Quit
    Last edited by ekrengel; 8th October 2010, 14:31. Reason: Attached whole script as I think you'll need it

  • #2
    Re: Create Exchange 2003 Mailbox

    I tried another method using cdo.person, but still a no go. Below is what I tried...I also noticed that I had a couple extra commas in the sub from the last three lines in my previous example, but removing those still did not resolve the issue.

    Code:
    Const AD_MODE_READ_WRITE = 3
    
    Sub CreateMailBox _
      (strMDBName,strStorageGroup,strServer,strAdminGroup,strOrganization)
    
    Set objPerson = CreateObject("CDO.Person")
    
    objPerson.DataSource.Open objUser.ADsPath,,AD_MODE_READ_WRITE
    
    Set objMailbox = objPerson.GetInterface("IMailboxStore")
    
           objMailbox.CreateMailbox "LDAP://CN=" & strMDBName & _
              ",CN=" & strStorageGroup & _
              ",CN=InformationStore" & _
              ",CN=" & strServer & _
              ",CN=Servers" & _
              ",CN=" & strAdminGroup & _
              ",CN=Administrative Groups" & _
              ",CN=" & strOrganization & _
              ",CN=Microsoft Exchange,CN=Services" & _
              ",CN=Configuration" & _
              ",DC=domain" & _
              ",DC=com"
    
    objPerson.DataSource.Save
    
    End Sub

    Comment

    Working...
    X