VBScript- Create Distribution Groups (DL) from CSV

I needed a quick script to create a series of distribution lists on an Exchange environment. I thought, "Cool, a chance to flex my PowerShell muscles!" From that I found new-qadgroup from the quest tools set and new-distributiongroup from the Exchange tools. After quite a bit of muddling around, I was never able to recreate my script.

Requirements I was trying to meet:

  1. Read all data from a CSV file (easy import-csv)
  2. Create a new DL from each line in the CSV (| %{new-distributiongroup -name $_.name}
  3. Populate each list with memers found in the members column (this was semi-colon seperated).
  4. Populate ExtensionAttribute3 with a common value 'FINANCE DLs'. This is used by our Dynamic Address Book views.
  5. Set limit of max message size sent to DL
  6. Set who was able to send to this DL (groups and people)
  7. Set SMTP and Proxy SMTP email addresses.

Unfortunately, after working on the first 3-4 items, I was stumped. VBScript failed me on a number of these, just in the fact that it's not widely published and a few answers varied. So, here is what I developed. The script fails when adding more than 1 additional proxy address, otherwise it worked for all my other tests.

(Sorry for the wrappage..)

'=====================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 3.1
'
' NAME: CreateDL.VBS
'
' AUTHOR: Eric Woodford
' DATE  : 7/25/2008
'
' COMMENT: Script is designed to create fully populated distribution lists.
'          The data is pulled from a CSV file.
'          Assigned fields are:
'               Display Name,
'               Alias,
'               SMTP Email address,
'               Proxy SMTP addresses,
'               Accept Messages from,
'               Maximum Accepted message size (KB - integer format please)
'               Members of the group
'                            
' Known issue: Accounts with more than 1 proxy address mail fail to load correctly. Still working out the details.  
' ProxyAddresses - <a href="http://www.eggheadcafe.com/forumarchives/scriptingVisualBasicscript/Aug2005/post23622005.asp
'=====================================================

Const" title="http://www.eggheadcafe.com/forumarchives/scriptingVisualBasicscript/Aug2005/post23622005.asp
'=====================================================

Const">http://www.eggheadcafe.com/forumarchives/scriptingVisualBasicscript/Aug2...</a> ForReading = 1, ForWriting = 2, ForAppending = 8
Const DLGroupEA3 = "Finance DLs"
Const GroupOU = "OU=Finance Users,"
Const CSVFilePath = "C:\Finance_DistributionLists.csv"
Const LogFIlePath = "C:\CreateDL.LOG"

Set fso = CreateObject("scripting.filesystemobject")
Set myCSV = fso.opentextfile(CSVFilePath, ForReading)
Set MyLogFile = fso.opentextfile(LogFIlePath, ForWriting, True)

Do While Not MyCSV.AtEndOfStream
        strCSVLine = myCSV.Readline
        If InStr(strCSVLine,"@")>0 Then ' if it contains a SMTPEmail Address, it must be valid (not a header).
                arrStrUser = Split(strCSVLine,",")
                strAlias = arrStrUser(1)
                strDisplayName = arrStrUser(0)
                strSMTP = arrStrUser(2)
                strMembers = arrStrUser(3)
                strAcceptFrom  = arrStrUser(4)
                IntMaxMsgSize = cint(arrStrUser(6))            
                CreateDistGroup strAlias,strDisplayName, strSMTP ,strAcceptFrom, IntMaxMsgSize
        End If
Loop
MyLogFile.Writeline "Adding Users"

Set myCSV = fso.opentextfile(CSVFilePath, ForReading)          
Do While Not MyCSV.AtEndOfStream
        strCSVLine = myCSV.Readline
        If InStr(strCSVLine,"@")>0 Then ' if it contains a SMTPEmail Address, it must be valid (not a header).
                arrStrUser = Split(strCSVLine,",")
                strAlias = arrStrUser(1)
                strMembers = arrStrUser(3)
                AddGroupMembers strAlias, strMembers
        End If
loop

MyLogFile.close
MyCSV.Close


Sub CreateDistGroup(strAlias, strDisplayname, strSMTP,  strAcceptMsgsFrom, intMaxSizeKB )
Dim strGroup, strDNSDomain
Dim objOU, objGroup, objUser

        Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h8
        Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000
        Const ADS_GROUP_TYPE_GLOBAL_GROUP = &h2
       
        Const ADS_PROPERTY_CLEAR = 1
        Const ADS_PROPERTY_UPDATE = 2
        Const ADS_PROPERTY_APPEND = 3
        Const ADS_PROPERTY_DELETE = 4

        Set objRootDSE = GetObject("LDAP://RootDSE")
        strDNSDomain = objRootDSE.Get("DefaultNamingContext")
        Set objOU = GetObject("LDAP://" & GroupOU & strDNSDomain )
        strNewGpLong = "CN=" & strAlias
        Err.Clear
        On Error Resume Next
        Set testGroup = GetObject ("LDAP://"&strNewGpLong&","& GroupOU & strDNSDomain)
        If Err <> 0 Then
                MyLogFile.Writeline "creating: " & strDisplayname &"("&strAlias&")"
                Set objGroup = objOU.Create("Group",strNewGpLong)
                objGroup.Put "sAMAccountName", strAlias
        Else
                MyLogFile.Writeline strDisplayname & " already exists"
        End If
        objGroup.put "Name", Replace(StrDisplayName," ","")    
        objGroup.Put "displayname", strDisplayname
        objGroup.Put "groupType", ADS_GROUP_TYPE_GLOBAL_GROUP  
        objGroup.put "extensionAttribute3", DLGroupEA3
        if intMaxSizeKB > 0 then objGroup.put "delivcontlength", intMaxSizeKB
        objGroup.mailenable
        objGroup.setInfo
        objGroup.put "dLMemSubmitPerms", "cn="&strAcceptMsgsFrom&","&GroupOU & strDNSDomain    
        if instr(strSMTP,";")=0 Then
                strNewSMTP = mid(strSMTP,6)
                'strNewSMTP = strSMTP
                MyLogFile.Writeline "Adding : " & strNewSMTP
                objGroup.Put "mail", strNewSMTP
                objGroup.put "targetAddress", strNewSMTP
                objGroup.PutEx ADS_PROPERTY_UPDATE, "ProxyAddresses", array(strSMTP)
                objGroup.SetInfo
        Else
                arrSMTP= Split(StrSMTP,";")
                strNewSMTP = mid(arrSMTP(0),6)
                MyLogFile.Writeline "Adding : " & strNewSMTP
                objGroup.Put "mail", strNewSMTP
               
                'http://support.microsoft.com/kb/q260251/
                x = 0
                For Each sAddress In arrSMTP
                        MyLogFile.Writeline "+" & sAddress
                        If x = 0 Then
                                objGroup.PutEx ADS_PROPERTY_UPDATE, "ProxyAddresses", array(sAddress)
                                objGroup.put "targetAddress", sAddress
                                x = x + 1
                        Else
                                objGroup.PutEx ADS_PROPERTY_APPEND, "ProxyAddresses", array(sAddress)
                        End if
                        objGroup.SetInfo
                Next                   
        End If
        objGroup.setInfo
        Set objGroup = Nothing
       
End Sub

Sub AddGroupMembers (strAlias, strMembers)
On Error Resume next
        Set objRootDSE = GetObject("LDAP://RootDSE")
        strDNSDomain = objRootDSE.Get("DefaultNamingContext")
        Set objGroup = GetObject ("LDAP://cn="&strAlias&","& GroupOU & strDNSDomain)
        If strMembers <> "" Then
                arrMembers = Split(strMembers,";")     
                For Each struser In arrMembers  
                        Err.Clear              
                        objGroup.Add("LDAP://cn="&strUser&","&GroupOU & strDNSDomain)
                       
                        If Err = 0 Then
                                MyLogFile.Writeline "Successfully added: " & strUser & " -> " & strAlias
                        Else
                                MyLogFile.Writeline "Failed : " & strUser & " -> " & strAlias
                        End If                         
                next
        End if         
End Sub