Bulk Modification | Sigkill IT

'=========================================================================
' ConvertOutlookContactsToAD.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 2/9/2013
' REQUIREMENTS: Requires Exchange Tools or CDOEXM.DLL on the computer running
' the script to create Email enabled contacts. The script also uses OLEDB,
' which requires running it with %systemroot%\SysWow64\wscript.exe,
' %systemroot%\SysWow64\cscript.exe, or a 64-bit OLEDB Provider.
' COMMENTS: The script is designed to take an Outlook CSV(DOS) Exported list of
' contacts which is used to create AD contacts. However, not all attributes directly
' translate or have an equivelent. For example, AD only has attributes for a single
' address where Outlook contacts can have business, home, and other addresses. The
' strUserType variable was created to allow you to pick 1 of those 3 options to use
' on the import.
' To use the script export your Outlook contacts to a CSV(DOS) file. Then set the
' variables for the log file (Default is in the same directory as the script), the
' DN of the container you want to create the AD Contacts in, the location of the
' Outlook Exported Contacts CSV file, and the UserType(Business, Home, Other)
' EXAMPLE: Create Contacts with CSV file in the same folder as the script
'          Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
'          Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
'          Dim contactsExport: contactsExport = "export.csv"
'          Dim strUserType: strUserType = "Business"
' EXAMPLE: Create Contacts Using the Home Address in the CSV
'          Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
'          Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
'          Dim contactsExport: contactsExport = "export.csv"
'          Dim strUserType: strUserType = "Home"
' EXAMPLE: Create Contacts with CSV file in a different folder as the script
'          Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
'          Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
'          Dim contactsExport: contactsExport = "C:\scripts\export.csv"
'          Dim strUserType: strUserType = "Business"
'=========================================================================
Option Explicit
' ------ START CONFIGURATION ------
Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
Dim contactsExport: contactsExport = "export.csv"
Dim strUserType: strUserType = "Business" 'Business, Home, Other
' ------ END CONFIGURATION ------

Call Logger(strLogFile, "USER:GENERAL, EMAIL, ORGANIZATION, ADDRESS, TELEPHONE", True)
Call CreateContacts(contactsExport, contactsDN, strUserType, strLogFile)
Wscript.Echo "Finished"

Private Sub CreateContacts(strContactsFile, strContactsDN, UserType, strLogFile)

    On Error Resume Next  'Start Error Handling

    'Ensure DN not ADS Path
    strContactsDN = Replace(strContactsDN,"LDAP://","",1,1,1)  

    'Grab Contacts With OLEDB - If Using a 64-bit OS you Must Use
    ' - C:\Windows\SysWow64\wscript.exe OR C:\Windows\SysWow64\cscript.exe
    ' - Alternatively, use a 64-bit OLEDB Provider (http://www.microsoft.com/en-us/download/details.aspx?id=20065)
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objFile: Set objFile = objFSO.GetFile(strContactsFile)
    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H0001
    Dim objConnection: Set objConnection = CreateObject("ADODB.Connection")
    Dim objRecordSet: Set objRecordSet = CreateObject("ADODB.Recordset")
    objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & objFile.ParentFolder & "\;" & _
        "Extended Properties=""text;HDR=YES;FMT=Delimited"""
    objRecordset.Open "SELECT * FROM [" & objFile.Name & "]", objConnection, adOpenStatic, adLockOptimistic, adCmdText
    If Err.Number <> 0 Then
        Err.Clear
        Call Logger(strLogFile, "Error Contacts File Is Already Opened, Quitting Script!", False)
    End If

    'Connect to AD and Get Contacts Container
    Const ADS_SCOPE_SUBTREE = 2
    Dim objConnection2: Set objConnection2 = CreateObject("ADODB.Connection")
    Dim objCommand: Set objCommand = CreateObject("ADODB.Command")
    objConnection2.Provider = "ADsDSOObject"
    objConnection2.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection2
    objCommand.Properties("Page Size") = 1000   'Override the Return 1000 Results Default      
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE    'Include Sub OU's
    objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & strContactsDN & "'"
    Dim objRecordset2: Set objRecordSet2 = objCommand.Execute
    If Not objRecordSet2.RecordCount > 0 Then
        Call Logger(strLogFile, "Error Contacts Container Doesn't Exist, Quitting Script!", False)
        Exit Sub
    End If
    Dim objContainer: Set objContainer = GetObject(objRecordSet2.Fields("AdsPath").Value)
    Dim strResult
    Dim blnAttributeFound
    Dim objContact, cFName, cLName, cInitials, cOffice, cWebpage
    Dim cEmail, cEmailAlias
    Dim cJobTitle, cDepartment, cCompany
    Dim cStreet, cCity, cState, cZip, cCountry, cPOBox
    Dim cHomePhone, cOtherHomePhone, cPager, cMobile, cFax, cOtherFax, cIPPhone, cOtherIPPhone, cTelephone, cOtherTelephone, cNotes
    Do Until objRecordset.EOF
        'Set Contact CN
        strResult = objRecordset.Fields.Item("First Name") & " " & objRecordset.Fields.Item("Last Name") & ":"
        Set objContact = objContainer.Create("Contact","CN=" & objRecordset.Fields.Item("First Name") & " " & objRecordset.Fields.Item("Last Name"))

        'General Attributes (Telephone/Other Telephone Under Telephones Attributes and E-mail Under Email Attributes
        If Not IsNull(objRecordset.Fields.Item("First Name")) AND Not IsNull(objRecordset.Fields.Item("Last Name")) Then
            cFName = objRecordset.Fields.Item("First Name")
            cLName = objRecordset.Fields.Item("Last Name")
            objContact.Put "givenName", cFName
            objContact.Put "SN", cLName
            objContact.Put "displayname", cFName & " " & cLName
        Elseif Not IsNull(objRecordset.Fields.Item("First Name")) AND IsNull(objRecordset.Fields.Item("Last Name")) Then
            cFName = objRecordset.Fields.Item("First Name")
            objContact.Put "givenName", cFName
            objContact.Put "displayname", cFName
        Elseif IsNull(objRecordset.Fields.Item("First Name")) AND Not IsNull(objRecordset.Fields.Item("Last Name")) Then
            cLName = objRecordset.Fields.Item("Last Name")
            objContact.Put "SN", cLName
            objContact.Put "displayname", cLName           
        End If
        If Not IsNull(objRecordset.Fields.Item("Initials")) Then
            cInitials = objRecordset.Fields.Item("Initials")
            objContact.Put "initials", cInitials
        End If
        If Not IsNull(objRecordset.Fields.Item("Office Location")) Then
            cOffice = objRecordset.Fields.Item("Office Location")
            objContact.Put "physicalDeliveryOfficeName", cOffice
        End If
        If Not IsNull(objRecordset.Fields.Item("Web Page")) Then
            cWebpage = objRecordset.Fields.Item("Web Page")
            objContact.Put "wWWHomePage", cWebpage
        End If
        objContact.SetInfo
        If Err.Number <> 0 Then
            Err.Clear
            strResult = strResult & "ERROR,ERROR,ERROR,ERROR,ERROR"
        Else
            strResult = strResult & "SUCCESS,"

            'Email Attributes (Assumes First Email)
            blnAttributeFound = False
            If Not IsNull(objRecordset.Fields.Item("E-mail Address")) Then
                blnAttributeFound = True
                cEmail = objRecordset.Fields.Item("E-mail Address")
                objContact.Put "Mail", cEmail
                objContact.MailEnable cEmail
            End If
            If Not IsNull(objRecordset.Fields.Item("E-mail Display Name")) Then
                blnAttributeFound = True
                cEmailAlias = objRecordset.Fields.Item("E-mail Display Name")
                objContact.Put "mailNickname", cEmailAlias
                objContact.MailEnable cEmail
            End If
            If blnAttributeFound = True Then
                objContact.SetInfo
            End If
            If Err.Number <> 0 Then
                Err.Clear
                strResult = strResult & "ERROR,"
            Else
                strResult = strResult & "SUCCESS,"
            End If

            'Organization Attributes
            blnAttributeFound = False
            If Not IsNull(objRecordset.Fields.Item("Job Title")) Then
                blnAttributeFound = True
                cJobTitle = objRecordset.Fields.Item("Job Title")
                objContact.Put "title", cJobTitle
            End If
            If Not IsNull(objRecordset.Fields.Item("Department")) Then
                blnAttributeFound = True
                cDepartment = objRecordset.Fields.Item("Department")
                objContact.Put "department", cDepartment
            End If
            If Not IsNull(objRecordset.Fields.Item("Company")) Then
                blnAttributeFound = True
                cCompany = objRecordset.Fields.Item("Company")
                objContact.Put "company", cCompany
            End If
            If blnAttributeFound = True Then
                objContact.SetInfo
            End If
            If Err.Number <> 0 Then
                Err.Clear
                strResult = strResult & "ERROR,"
            Else
                strResult = strResult & "SUCCESS,"
            End If

            'Address Attributes (Add Variable to choose business, home, or other)
            blnAttributeFound = False
            Select Case UCase(UserType)
            Case "BUSINESS"
                If Not IsNull(objRecordset.Fields.Item("Business Street")) Then
                    blnAttributeFound = True
                    cStreet = objRecordset.Fields.Item("Business Street")
                    If Not IsNull(objRecordset.Fields.Item("Business Street 2")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Business Street 2")
                    End If
                    If Not IsNull(objRecordset.Fields.Item("Business Street 3")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Business Street 3")
                    End If
                    objContact.Put "streetAddress", cStreet
                End If
                If Not IsNull(objRecordset.Fields.Item("Business City")) Then
                    blnAttributeFound = True
                    cCity = objRecordset.Fields.Item("Business City")
                    objContact.Put "l", cCity
                End If
                If Not IsNull(objRecordset.Fields.Item("Business State")) Then
                    blnAttributeFound = True
                    cState = objRecordset.Fields.Item("Business State")
                    objContact.Put "st", cState
                End If
                If Not IsNull(objRecordset.Fields.Item("Business Postal Code")) Then
                    blnAttributeFound = True
                    cZip = objRecordset.Fields.Item("Business Postal Code")
                    objContact.Put "postalCode", cZip
                End If
                If Not IsNull(objRecordset.Fields.Item("Business Country/Region")) Then
                    blnAttributeFound = True
                    cCountry = objRecordset.Fields.Item("Business Country/Region")
                    objContact.Put "co", cCountry  'Note: use co to choose Country Name in ISO3166
                End If
                If Not IsNull(objRecordset.Fields.Item("Business Address PO Box")) Then
                    blnAttributeFound = True
                    cPOBox = objRecordset.Fields.Item("Business Address PO Box")
                    objContact.Put "postOfficeBox", cPOBox
                End If
            Case "HOME"
                If Not IsNull(objRecordset.Fields.Item("Home Street")) Then
                    blnAttributeFound = True
                    cStreet = objRecordset.Fields.Item("Home Street")
                    If Not IsNull(objRecordset.Fields.Item("Home Street 2")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Home Street 2")
                    End If
                    If Not IsNull(objRecordset.Fields.Item("Home Street 3")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Home Street 3")
                    End If
                    objContact.Put "streetAddress", cStreet
                End If
                If Not IsNull(objRecordset.Fields.Item("Home City")) Then
                    blnAttributeFound = True
                    cCity = objRecordset.Fields.Item("Home City")
                    objContact.Put "l", cCity
                End If
                If Not IsNull(objRecordset.Fields.Item("Home State")) Then
                    blnAttributeFound = True
                    cState = objRecordset.Fields.Item("Home State")
                    objContact.Put "st", cState
                End If
                If Not IsNull(objRecordset.Fields.Item("Home Postal Code")) Then
                    blnAttributeFound = True
                    cZip = objRecordset.Fields.Item("Home Postal Code")
                    objContact.Put "postalCode", cZip
                End If
                If Not IsNull(objRecordset.Fields.Item("Home Country/Region")) Then
                    blnAttributeFound = True
                    cCountry = objRecordset.Fields.Item("Home Country/Region")
                    objContact.Put "co", cCountry  'Note: use co to choose Country Name in ISO3166
                End If
                If Not IsNull(objRecordset.Fields.Item("Home Address PO Box")) Then
                    blnAttributeFound = True
                    cPOBox = objRecordset.Fields.Item("Home Address PO Box")
                    objContact.Put "postOfficeBox", cPOBox
                End If
            Case "OTHER"
                If Not IsNull(objRecordset.Fields.Item("Other Street")) Then
                    blnAttributeFound = True
                    cStreet = objRecordset.Fields.Item("Other Street")
                    If Not IsNull(objRecordset.Fields.Item("Other Street 2")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Other Street 2")
                    End If
                    If Not IsNull(objRecordset.Fields.Item("Other Street 3")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Other Street 3")
                    End If
                    objContact.Put "streetAddress", cStreet
                End If
                If Not IsNull(objRecordset.Fields.Item("Other City")) Then
                    blnAttributeFound = True
                    cCity = objRecordset.Fields.Item("Other City")
                    objContact.Put "l", cCity
                End If
                If Not IsNull(objRecordset.Fields.Item("Other State")) Then
                    blnAttributeFound = True
                    cState = objRecordset.Fields.Item("Other State")
                    objContact.Put "st", cState
                End If
                If Not IsNull(objRecordset.Fields.Item("Other Postal Code")) Then
                    blnAttributeFound = True
                    cZip = objRecordset.Fields.Item("Other Postal Code")
                    objContact.Put "postalCode", cZip
                End If
                If Not IsNull(objRecordset.Fields.Item("Other Country/Region")) Then
                    blnAttributeFound = True
                    cCountry = objRecordset.Fields.Item("Other Country/Region")
                    objContact.Put "co", cCountry  'Note: use co to choose Country Name in ISO3166
                End If
                If Not IsNull(objRecordset.Fields.Item("Other Address PO Box")) Then
                    blnAttributeFound = True
                    cPOBox = objRecordset.Fields.Item("Other Address PO Box")
                    objContact.Put "postOfficeBox", cPOBox
                End If
            End Select
            If blnAttributeFound = True Then
                objContact.SetInfo
            End If
            If Err.Number <> 0 Then
                Err.Clear
                strResult = strResult & "ERROR,"
            Else
                strResult = strResult & "SUCCESS,"
            End If

            'Telephone Attributes (Add Variable to choose business, home or other)
            blnAttributeFound = False
            If Not IsNull(objRecordset.Fields.Item("Home Phone")) Then
                blnAttributeFound = True
                cHomePhone = objRecordset.Fields.Item("Home Phone")
                objContact.Put "homePhone", cHomePhone
            End If
            If Not IsNull(objRecordset.Fields.Item("Home Phone 2")) Then
                blnAttributeFound = True
                cOtherHomePhone = objRecordset.Fields.Item("Home Phone 2")
                objContact.PutEx 3, "otherHomePhone", Array(cOtherHomePhone)
            End If
            If Not IsNull(objRecordset.Fields.Item("Pager")) Then
                blnAttributeFound = True
                cPager = objRecordset.Fields.Item("Pager")
                objContact.Put "pager", cPager
            End If
            If Not IsNull(objRecordset.Fields.Item("Mobile Phone")) Then
                blnAttributeFound = True
                cMobile = objRecordset.Fields.Item("Mobile Phone")
                objContact.Put "mobile", cMobile
            End If
            If Not IsNull(objRecordset.Fields.Item("Business Fax")) Then
                blnAttributeFound = True
                cFax = objRecordset.Fields.Item("Business Fax")
                objContact.Put "facsimileTelephoneNumber", cFax
            End If
            If Not IsNull(objRecordset.Fields.Item("Home Fax")) Then
                blnAttributeFound = True
                cOtherFax = objRecordset.Fields.Item("Home Fax")
                objContact.PutEx 3, "otherFacsimileTelephoneNumber", Array(cOtherFax)
            End If
            If Not IsNull(objRecordset.Fields.Item("Other Fax")) Then
                blnAttributeFound = True
                cOtherFax = objRecordset.Fields.Item("Other Fax")
                objContact.PutEx 3, "otherFacsimileTelephoneNumber", Array(cOtherFax)
            End If
            If Not IsNull(objRecordset.Fields.Item("Business Phone")) Then
                blnAttributeFound = True
                cIPPhone = objRecordset.Fields.Item("Business Phone")
                objContact.Put "ipPhone", cIPPhone
            End If
            If Not IsNull(objRecordset.Fields.Item("Business Phone 2")) Then
                blnAttributeFound = True
                cOtherIPPhone = objRecordset.Fields.Item("Business Phone 2")
                objContact.PutEx 3, "otherIpPhone", Array(cOtherIPPhone)
            End If
            If Not IsNull(objRecordset.Fields.Item("Company Main Phone")) Then
                blnAttributeFound = True
                cOtherIPPhone = objRecordset.Fields.Item("Company Main Phone")
                objContact.PutEx 3, "otherIpPhone", Array(cOtherIPPhone)
            End If
            If Not IsNull(objRecordset.Fields.Item("Primary Phone")) Then
                blnAttributeFound = True
                cTelephone = objRecordset.Fields.Item("Primary Phone")
                objContact.Put "telephoneNumber", cTelephone
            End If
            If Not IsNull(objRecordset.Fields.Item("Other Phone")) Then
                blnAttributeFound = True
                cOtherTelephone = objRecordset.Fields.Item("Other Phone")
                objContact.Put "otherTelephone", cOtherTelephone
            End If
            If Not IsNull(objRecordset.Fields.Item("Notes")) Then
                blnAttributeFound = True
                cNotes = objRecordset.Fields.Item("Notes")
                objContact.Put "info", cNotes
            End If
            If blnAttributeFound = True Then
                objContact.SetInfo
            End If
            If Err.Number <> 0 Then
                Err.Clear
                strResult = strResult & "ERROR"
            Else
                strResult = strResult & "SUCCESS"
            End If
        End If

        'Log Results
        Call Logger(strLogFile, strResult, False)      
        objRecordset.MoveNext
    Loop

    objRecordset.Close
    objRecordset2.Close

    On Error Goto 0  'End Error Handling

End Sub

Private Sub Logger(fileName, logMessage, blnNewLog)

    On Error Resume Next

    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Dim logName
    If InStr(1,fileName,"\",1) > 0 Then
        logName = fileName
        If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
            If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
                If Not objFSO.FolderExists(logName) Then
                    If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        objFSO.CreateFolder logName 'Create Folder In Current Path
                        Exit Sub
                    Else
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
                        Exit Sub
                    End If
                End If
            Else
                If Not objFSO.FileExists(logName) Then
                    If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder
                    End If
                End If
            End If
        End If
    Else
        logName = scriptPath & fileName
    End If
    Dim logFile
    If blnNewLog = True Then
        Set logFile = objFSO.CreateTextFile(logName, True)
    Else
        If objFSO.FileExists(logName) Then
            Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
        Else
            Set logFile = objFSO.CreateTextFile(logName, True)
        End If
    End If
    logFile.WriteLine logMessage
    logFile.Close
    Set objFSO = Nothing

    On Error Goto 0

End Sub

'=========================================================================
' GroupModifyManager.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/4/2013
' COMMENTS: This will set the manager for a group and optionally allow them
' to update group membership. Set the manager by specificying the LDAP path
' or DN of the user you want to set. Set the group to modify by specifying
' the LDAP path or DN of a specific group; you can also set this to an OU
' to make bulk changes. Last, specify whether the manager can update the
' group membership by setting the True/False value.
' EXAMPLE: Modify a Specific Group's Manager and Allow Them to Update Membership
'          Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com"
'          Dim strGroupPath: strGroupPath = "LDAP://CN=Testgroup,OU=Groups,DC=domain,DC=com"
'          Dim blnUpdateMembership: blnUpdateMembership = True
' EXAMPLE: Modify a Specific Group's Manager and Do Not Allow Them to Update Membership
'          Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com"
'          Dim strGroupPath: strGroupPath = "LDAP://CN=Testgroup,OU=Groups,DC=domain,DC=com"
'          Dim blnUpdateMembership: blnUpdateMembership = False
' EXAMPLE: Bulk Modify All Group's Managers in an OU and Allow Them to Update Membership
'          Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com"
'          Dim strGroupPath: strGroupPath = "LDAP://OU=Groups,DC=domain,DC=com"
'          Dim blnUpdateMembership: blnUpdateMembership = True
'=========================================================================
Option Explicit
' ------ START CONFIGURATION ------
Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com"
Dim strGroupPath: strGroupPath = "LDAP://OU=Groups,DC=domain,DC=com"
Dim blnUpdateMembership: blnUpdateMembership = True
' ------ END CONFIGURATION ------

Dim strLogName: strLogName = Replace(WScript.ScriptName,".vbs",".txt")
Call Logger(strLogName, "", True)
Call ModifyManger(strGroupPath, strManager, blnUpdateMembership, strLogName)
Wscript.Echo "Finished"

Private Sub ModifyManger(groupPath, groupManager, groupUpdateMembership, groupLogName)

    On Error Resume Next

    'Ensure DN not ADS Path
    groupPath = Replace(groupPath,"LDAP://","",1,1,1)
    groupManager = Replace(groupManager,"LDAP://","",1,1,1)

    'Constants/Variables to Set Manager Update List Access
    Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5
    Const ADS_RIGHT_DS_WRITE_PROP = &H20
    Const ADS_ACEFLAG_INHERIT_ACE = &H00002 'Not Needed but Kept it here for Reference
    Const ADS_ACEFLAG_DONT_INHERIT_ACE = &H0
    Const ADS_FLAG_OBJECT_TYPE_PRESENT = &H01
    Const ADS_OBJECT_WRITE_MEMBERS = "{BF9679C0-0DE6-11D0-A285-00AA003049E2}"
    Dim objSecurityDescriptor, objDACL, objUser, objACE

    'Connect to AD
    Dim objConnection: Set objConnection = CreateObject("ADODB.Connection")
    Dim objCommand: Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    objCommand.Properties("Page Size") = 1000   'Override the Return 1000 Results Default
    Const ADS_SCOPE_SUBTREE = 2
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE    'Include Sub OU's
    objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & strGroupPath & "' WHERE objectClass='group'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    If Not objRecordSet.RecordCount > 0 Then
        Call Logger(groupLogName, "Error No Groups Found Quitting Script!", False)
        Exit Sub
    End If
    objRecordSet.MoveFirst
    Dim objGroup
    Do Until objRecordSet.EOF
        Call Logger(groupLogName, objRecordSet.Fields("ADsPath").Value & vbCrLf & "**********************************************", False)
        Set objGroup = GetObject(objRecordSet.Fields("ADsPath").Value)
        objGroup.Put "managedBy", groupManager
        objGroup.SetInfo
        If Err.Number <> 0 Then
            Err.Clear
            Call Logger(groupLogName, "Error Updating Manager to: " & groupManager, False)
        Else
            Call Logger(groupLogName, "Success Updating Manager to: " & groupManager, False)
            If groupUpdateMembership = True Then
                'Allow Manager to Update Member List
                Call Logger(groupLogName, "Allow Manager to Update Member List: True", False)
                Set objSecurityDescriptor = objGroup.Get("ntSecurityDescriptor")
                Set objDACL = objSecurityDescriptor.DiscretionaryACL
                Set objUser = GetObject("LDAP://" & objGroup.Get("managedBy"))
                Set objACE = CreateObject("AccessControlEntry")
                objACE.Trustee = "snapretail\" & objUser.Get("sAMAccountName")
                objACE.AccessMask = ADS_RIGHT_DS_WRITE_PROP
                objACE.AceFlags = ADS_ACEFLAG_DONT_INHERIT_ACE
                objACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
                objACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT
                objACE.objectType = ADS_OBJECT_WRITE_MEMBERS
                objDACL.AddAce(objACE)
                objSecurityDescriptor.DiscretionaryACL = objDACL
                objGroup.Put "ntSecurityDescriptor", Array(objSecurityDescriptor)
                objGroup.SetInfo
                If Err.Number <> 0 Then
                    Err.Clear
                    Call Logger(groupLogName, "Error Allowing Manager to Update Member List", False)
                Else
                    Call Logger(groupLogName, "Success Allowing Manager to Update Member List", False)
                End If
            End If
        End If

        Call Logger(groupLogName, "" & vbCrLf, False)

        objRecordSet.MoveNext

    Loop

    On Error Goto 0

End Sub

Private Sub Logger(fileName, logMessage, blnNewLog)

    On Error Resume Next

    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Dim logName
    If InStr(1,fileName,"\",1) > 0 Then
        logName = fileName
        If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
            If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
                If Not objFSO.FolderExists(logName) Then
                    If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        objFSO.CreateFolder logName 'Create Folder In Current Path
                       Exit Sub
                    Else
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
                       Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
                       Exit Sub
                    End If
                End If
            Else
                If Not objFSO.FileExists(logName) Then
                    If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder
                       Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder
                   End If
                End If
            End If
        End If
    Else
        logName = scriptPath & fileName
    End If
    Dim logFile
    If blnNewLog = True Then
        Set logFile = objFSO.CreateTextFile(logName, True)
    Else
        If objFSO.FileExists(logName) Then
            Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
        Else
            Set logFile = objFSO.CreateTextFile(logName, True)
        End If
    End If
    logFile.WriteLine logMessage
    logFile.Close
    Set objFSO = Nothing

    On Error Goto 0

End Sub

Sigkill IT

Code and IT Knowledge

Tag Archives: Bulk Modification

ConvertOutlookContactsToAD.vbs

GroupModifyManager.vbs