Script Adding Entries to Distribution Lists in the GAL

A reader named Ashwath posted a comment last week asking about the possibility of updating a public distribution list. Here’s what Ashwath said.

I am trying to find an automated way to add members to a Public Distribution List on the Global Address List. Right now, the only way to do it is to manually look up for a contact one by one in the Global Address List and then add them, but I’ve close to 300+ names to do this. Would you be help to help with a macro for either outlook 2007/Excel 2007 that can automatically pick e-mail addresses from an excel sheet and then add them to the PDL?

P.S: This Distribution List is not an Outlook Distribution List. It is a Distribution List created on the GLobal Address List by my ‘IT’ department; so there is no easy way to copy and paste multiple e-mail addresses.

Public distribution lists (i.e. a mail enabled Active Directory groups) have little to do with Outlook from a scripting perspective. They reside in Active Directory and are not created or updated through the scripting of Outlook. Instead, they are handled through ADSI (Active Directory Services Interfaces) scripting. Although the solution doesn’t involve Outlook I could have written the necessary script in VBA and run it from either Outlook or Excel. There’s little point to doing it in Outlook and it makes more sense to keep the script outside of Excel since that will give Ashwath more flexibility. In my opinion the best solution is to create the script using VBscript, which is the approach I’ve taken here. One of the benefits of using VBscript is that Ashwath can drop the script in his computer’s Send to folder enabling him to send a spreadsheet to the script for processing. By taking this approach Ashwath can even update different distribution lists from the same spreadsheet.

The script works by opening and reading an Excel spreadsheet. For each line in the spreadsheet the script gets an email address from column A and a distribution list (i.e. group) name from column B. After checking to make sure that the distribution list exists and that there is a user account with the email address, the script adds the user account associated with the email address to the distribution list. If the distribution list does not exist or an account with the specified email address isn’t found, then the script writes “Group not found” or “User account not found” respectively in column C of that entry in the spreadsheet. When the script has finished processing Ashwath can open the spreadsheet and see which updates succeeded (column C will be empty) and which ones failed (column C will say “Failed”).

Instructions.

1. Open Notepad.
2. Copy the script and paste it into Notepad.
3. Edit the script per the comments I included in it. At a minimum you must edit the domain name on line #2.
4. Save the file to the Send To folder with a .vbs extension. You can name the script anything you want.
5. Close Notepad.

'On the next line change "company.com" to your domain name
Const AD_DOMAIN_NAME = "company.com"
Const SCRIPT_NAME = "Add Users to Groups"

Dim excApp, excWkb, excWks, lngRow
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Open(WScript.Arguments(0))
Set excWks = excWkb.Worksheets(1)
lngRow = 1
Do While excWks.Cells(lngRow, 1) <> ""
    Add2Group excWks.Cells(lngRow,1), excWks.Cells(lngRow,2)
    lngRow = lngRow + 1
Loop
Set excWks = Nothing
excWkb.Close True
Set excWkb = Nothing
Set excApp = Nothing
MsgBox "Processing complete", vbInformation+vbOKOnly, SCRIPT_NAME
WScript.Quit

Sub Add2Group(strEmail, strGroup)
    Const ADS_PROPERTY_APPEND = 3 
    Dim objGroup, strGroupPath, strUserPath
    strGroupPath = Get_AD_Object_Path("SELECT ADsPath FROM 'LDAP://" & AD_DOMAIN_NAME & "' WHERE objectClass='group' AND Name='" & strGroup & "'")
    strUserPath = Get_AD_Object_Path("SELECT ADsPath FROM 'LDAP://" & AD_DOMAIN_NAME & "' WHERE objectClass='user' AND objectCategory='Person' AND Mail='" & strEmail & "'")
    If strGroupPath = "Not Found" Then
        excWks.Cells(lngRow,3) = "Group not found"
    else
        If strUserPath = "Not Found" Then
            excWks.Cells(lngRow,3) = "User account not found"
        Else
            Set objGroup = GetObject(strGroupPath) 
            objGroup.Add strUserPath
            objGroup.SetInfo
        End If
    End If
    Set objGroup = Nothing
End Sub

Function Get_AD_Object_Path(strQuery)
    Dim rsDetails
    Set rsDetails = Wscript.CreateObject("ADODB.Recordset")
    With rsDetails
        .ActiveConnection = "Provider=ADSDSOObject"
        .Source = strQuery
        .CursorType = 0
        .CursorLocation = 2
        .LockType = 1
        .Open()
    End With
    If (Not rsDetails.BOF) And (Not rsDetails.EOF) Then
        Get_AD_Object_Path = rsDetails.Fields("ADsPath").Value
    Else
        Get_AD_Object_Path = "Not Found"
    End If
    Set rsDetails = Nothing
End Function

Usage.

To use the script, right-click on a spreadsheet containing your updates and select Send to then select the script name you used in #3 of the instructions. The script will open the spreadsheet and process the entries on the first sheet only. The script assumes that the sheet does not have a header and that each line contains one entry. For each line the script assumes that column A contains the email address of the account to add and that column B contains the name of the distribution list you want to add the group to. The script will process all lines until it finds that column A is blank. For the script to work you must have the necessary permissions in Active Directory to make changes to the target distribution list(s). As with any script please test it thoroughly before placing it into production.

Revisions.

• Revision 1

This revision is for Ashwath who has since shared that the user account could be in any one of three different domains. This version of the code allows Ashwath to specify the three domain names which the code then searches looking for the user account. It will stop searching as soon as it finds the user account in a domain (i.e. no unnecessary searches) and will still generate a user account not found message if it fails to find the account in any of the three domains.

'On the next three lines change "company.com" to your domain names
Const AD_DOMAIN_NAME1 = "company.com"
Const AD_DOMAIN_NAME2 = "company.com"
Const AD_DOMAIN_NAME3 = "company.com"
Const SCRIPT_NAME = "Add Users to Groups"

Dim excApp, excWkb, excWks, lngRow
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Open(WScript.Arguments(0))
Set excWks = excWkb.Worksheets(1)
lngRow = 1
Do While excWks.Cells(lngRow, 1) <> ""
    Add2Group excWks.Cells(lngRow,1), excWks.Cells(lngRow,2)
    lngRow = lngRow + 1
Loop
Set excWks = Nothing
excWkb.Close True
Set excWkb = Nothing
Set excApp = Nothing
MsgBox "Processing complete", vbInformation+vbOKOnly, SCRIPT_NAME
WScript.Quit

Sub Add2Group(strEmail, strGroup)
    Const ADS_PROPERTY_APPEND = 3 
    Dim objGroup, strGroupPath, strUserPath
    strGroupPath = Get_AD_Object_Path("SELECT ADsPath FROM 'LDAP://" & AD_DOMAIN_NAME & "' WHERE objectClass='group' AND Name='" & strGroup & "'")
    strUserPath = Get_AD_Object_Path("SELECT ADsPath FROM 'LDAP://" & AD_DOMAIN_NAME1 & "' WHERE objectClass='user' AND objectCategory='Person' AND Mail='" & strEmail & "'")
    If strUserPath = "Not Found" Then
        strUserPath = Get_AD_Object_Path("SELECT ADsPath FROM 'LDAP://" & AD_DOMAIN_NAME2 & "' WHERE objectClass='user' AND objectCategory='Person' AND Mail='" & strEmail & "'")
        If strUserPath = "Not Found" Then
            strUserPath = Get_AD_Object_Path("SELECT ADsPath FROM 'LDAP://" & AD_DOMAIN_NAME3 & "' WHERE objectClass='user' AND objectCategory='Person' AND Mail='" & strEmail & "'")
        End If
    End If
    If strGroupPath = "Not Found" Then
        excWks.Cells(lngRow,3) = "Group not found"
    else
        If strUserPath = "Not Found" Then
            excWks.Cells(lngRow,3) = "User account not found"
        Else
            Set objGroup = GetObject(strGroupPath) 
            objGroup.Add strUserPath
            objGroup.SetInfo
        End If
    End If
    Set objGroup = Nothing
End Sub

Function Get_AD_Object_Path(strQuery)
    Dim rsDetails
    Set rsDetails = Wscript.CreateObject("ADODB.Recordset")
    With rsDetails
        .ActiveConnection = "Provider=ADSDSOObject"
        .Source = strQuery
        .CursorType = 0
        .CursorLocation = 2
        .LockType = 1
        .Open()
    End With
    If (Not rsDetails.BOF) And (Not rsDetails.EOF) Then
        Get_AD_Object_Path = rsDetails.Fields("ADsPath").Value
    Else
        Get_AD_Object_Path = "Not Found"
    End If
    Set rsDetails = Nothing
End Function

About these ads