en Passant
not letting life just pass on by
VBScript- Create Distribution Groups (DL) from CSV
Tags:
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:
- Read all data from a CSV file (easy
import-csv) - Create a new DL from each line in the CSV (
| %{new-distributiongroup -name $_.name} - Populate each list with memers found in the members column (this was semi-colon seperated).
- Populate ExtensionAttribute3 with a common value 'FINANCE DLs'. This is used by our Dynamic Address Book views.
- Set limit of max message size sent to DL
- Set who was able to send to this DL (groups and people)
- 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
'
' 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
Comments
Post new comment