Jan 04

GroupModifyManager.vbs

'=========================================================================
' 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

 

Dec 21

ListRunningScripts.vbs

'=========================================================================
' ListRunningScripts.vbs
' VERSION: 1.1 - Null value is returned when a script is launched by another user on the local computer and the script is not elevated for UAC. I added a check to look for this and alert the user.
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 12/21/2012
' COMPATIBLE: Windows XP, Server 2003, and Above
' COMMENTS: If you ever had a wscript.exe or cscript.exe process running but
' need to know the exact script it is running you can find the answer using
' the CommandLine property in the WIN32_Process Class. You can view this
' property in Task Manager by clicking View->Choose Columns. Alternatively,
' you can script it as I have below. The script works on the local computer
' as well as remote computers. Set the computer to run the script against
' and optionally set it to show the Scripting Host that launched the script.
' EXAMPLE: List Running Scripts on Local Computer Without Script Host
'          Dim strComputer: strComputer = "."
'          Dim blnShowScriptHost: blnShowScriptHost = False
' EXAMPLE: List Running Scripts on Local Computer With Script Host
'          Dim strComputer: strComputer = "."
'          Dim blnShowScriptHost: blnShowScriptHost = True
' EXAMPLE: List Running Scripts on Remote Computer Without Script Host
'          Dim strComputer: strComputer = "server"
'          Dim blnShowScriptHost: blnShowScriptHost = False
' EXAMPLE: List Running Scripts on Remote Computer With Script Host
'          Dim strComputer: strComputer = "server"
'          Dim blnShowScriptHost: blnShowScriptHost = True
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strComputer: strComputer = "."
Dim blnShowScriptHost: blnShowScriptHost = False
' ------ END CONFIGURATION ------

Wscript.Echo ListRunningScripts(strComputer)

Private Function ListRunningScripts(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colProcesses: Set colProcesses = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = " & "'Wscript.exe' OR Name = 'Cscript.exe'")
    Dim objProcess
    Dim strResult: strResult = ""
    Dim count: count = 0
    If Not colProcesses.Count = 0 Then
        For Each objProcess in colProcesses
            count = count + 1
            If blnShowScriptHost = True Then
                strResult = strResult & objProcess.CommandLine & vbCrLf
            Else
                If IsNull(objProcess.CommandLine) OR IsNull(objProcess.ExecutablePath) Then
                    strResult = strResult & "NULL (You need to use Run As Administrator)" & vbCrLf
                Else
                    strResult = strResult & Trim(Replace(Replace(objProcess.CommandLine, objProcess.ExecutablePath, "", 1, 1, 1), objProcess.Name, 1, 1, 1)) & vbCrLf
                End If
            End If
        Next
    End If

    strResult = count & " Scripts are running" & vbCrLf & "----------------------" & vbCrLf & strResult

    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If

    ListRunningScripts = strResult

    On Error Goto 0

End Function

 

Dec 08

IDK.vbs

'=========================================================================
' IDK.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 12/8/2012
' COMMENTS: If you have ever had an issue making a decision like "What Should
' I eat for dinner" or "What should I do tonight?" then IDK aka "I Don't Know"
' is the script for you. It will randomly select a decision for you from a line
' delimited text file you pass to the script. You can run the script with Wscript
' by dragging and dropping your file onto the script or with Cscript by using
' the file path as the argument passed. You can make lists for all types of
' decisions you commonly make, and a few ideas are Yes/No, Magic8Ball, Pizza Shops,
' Restaurants, Movies, etc.
' EXAMPLE: Drag-N-Drop with WScript
'          Drag and Drop a file called Pizza.txt onto IDK.vbs to select a pizza shop
' EXAMPLE: From and command prompt with Cscript
'          C:\>cscript IDK.vbs "C:\My Lists\pizza.txt"
'=========================================================================
Option Explicit

Wscript.Echo IDK(wscript.arguments.item(0))

Private Function IDK(filePath)

    On Error Resume Next

    Const ForReading = 1
    Dim strResult
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FileExists(filePath) Then
        strResult = "ERROR - Input File Does Not Exist!"
    Else
        'Parse Input File into Array
        Dim objTextFile: Set objTextFile = objFSO.OpenTextFile(filePath, ForReading)
        Dim arrLine()
        Dim intSize: intSize = 0
        Dim strLine, blnMatch: blnMatch = False
        Do Until objTextFile.AtEndOfStream
            strLine = Trim(objTextFile.Readline)
            If Not strLine = "" Then
                blnMatch = True
                ReDim Preserve arrLine(intSize)
                arrLine(intSize) = strLine
                intSize = intSize + 1
            End If
        Loop
        'Randomly Select
        Dim intHighNumber: intHighNumber = UBound(arrLine)
        Dim intLowNumber: intLowNumber = LBound(arrLine)
        Dim intNumber
        Randomize
        strResult = arrLine(Int((intHighNumber - intLowNumber + 1) * Rnd + intLowNumber))      
    End If

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "ERROR - Parsing Input File!"
    End If 
    IDK = strResult

    Set objFSO = Nothing

    On Error Goto 0

End Function

 

Oct 29

ChangePrimaryEmailDomain.vbs

'=========================================================================
' ChangePrimaryEmailDomain.vbs
' VERSION: 1.1 - Corrected Case Sensitive Error When Matching SMTP
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 10/29/2012
' COMMENTS: Pass the ADsPath or Dinstinguished Name of the User/OU and New
' Email Domain to Modify the User(s) Primary SMTP Email Domain. The Script Will
' Grab the Local Part of the Users Current Primary Email, Append the New
' Domain to the End to Create the New Primary Email, and Make the Current Primay
' Email an Alias. It Will Also Update the Mail Attribute So the New Primary
' Email Displays On the General Tab of the Users Property in AD Users and Computers.
' Any Non-Email Enabled Users Will Be Skipped.
' EXAMPLE: Modify the User John Doe's Primary Email Domain (jdoe@domain.com -> jdoe@newdomain.com)
' Dim UserOrOU: UserOrOU = "CN=John Doe,CN=Users,DC=domain,DC=com"
' Dim NewDomain: NewDomain = "@newdomain"
' EXAMPLE: Modify All Users Primary Email Domain in an OU
' Dim UserOrOU: UserOrOU = "OU=Financial,DC=domain,DC=com"
' Dim NewDomain: NewDomain = "@newdomain.com"
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim UserOrOU: UserOrOU = "OU=Financial,DC=domain,DC=com"
Dim NewDomain: NewDomain = "@newdomain.com"
' ------ END CONFIGURATION ------

Dim strLog: strLog = Replace(Wscript.ScriptName,".vbs",".txt")
Call ChangePrimaryEmailDomain(UserOrOU,NewDomain)
Wscript.Echo "Finished"

Private Function ChangePrimaryEmailDomain(strDN, strNewDomain)

On Error Resume Next

'Ensure We have a DN
strDN = Replace(strDN,"LDAP://","",1,1,1)

'Start Log File
Call Logger(strLog, "++++++++++++++++++++++++++++++++++++++++", True)
Call Logger(strLog, "+ " & Wscript.ScriptName, False)
Call Logger(strLog, "+ DN: " & strDN, False)
Call Logger(strLog, "+ New Domain: " & strNewDomain, False)
Call Logger(strLog, "++++++++++++++++++++++++++++++++++++++++" & vbCrLf & vbCrLf & vbCrLf, False)

'PutEx Constants
Const ADS_PROPERTY_CLEAR = 1
Const ADS_PROPERTY_UPDATE = 2
Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_DELETE = 4

'Search AD
Const ADS_SCOPE_SUBTREE = 2
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
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT AdsPath FROM 'LDAP://" & strDN & "' WHERE objectClass='user' AND objectCategory='person'"
Dim objRecordSet: Set objRecordSet = objCommand.Execute
Dim objUser, strEmail, strOldPrimary, strNewPrimary
Dim arrEmail()
Dim arrProxyAddresses
Dim i
Dim blnFound

' Process Results and List Emails
If objRecordSet.RecordCount < 1 Then
Call Logger(strLog, "Error No Records Found for DN", False)
Exit Function
End If
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
Call Logger(strLog, vbCrLf & vbCrLf & "USER:" & objUser.AdsPath & vbCrLf & "=====================================================", False)
i = 0
'Build Array of Email Addresses and Get Primary SMTP
Call Logger(strLog, "Original Email Addresses" & vbCrLf & "------------------------------", False)
If Not IsArray(objUser.proxyAddresses) Then
'SKIP - Not Email Enabled
Call Logger(strLog, "SKIPPING - NOT EMAIL ENABLED", False)
Else
For Each strEmail in objUser.proxyAddresses
Call Logger(strLog, strEmail, False)
'Build Array of Email Addresses and Make All SMTP Addresses Lowercase
ReDim Preserve arrEmail(i)
If Left(strEmail,5) = "SMTP:" Then
strOldPrimary = "SMTP:" & LCase(Mid(strEmail,6))
arrEmail(i) = strOldPrimary
Elseif Left(strEmail,5) = "smtp:" Then
arrEmail(i) = "smtp:" & LCase(Mid(strEmail,6))
Else
arrEmail(i) = strEmail
End If
i = i + 1
Next

'Build New Primary SMTP (Assuming Local and Domain Are Lowercase From Above)
strNewPrimary = Left(strOldPrimary,InStr(1,strOldPrimary,"@",1)-1) & strNewDomain

'Modify Array(Assuming Local and Domain Are Lowercase From Above)
blnFound = False
For i = LBound(arrEmail) to UBound(arrEmail)
'Make the Old SMTP an Alias
If arrEmail(i) = strOldPrimary Then
arrEmail(i) = Replace(strOldPrimary,"SMTP:","smtp:",1,1,0)
End If

'New Primary SMTP is an Alias, Make it Primary
If arrEmail(i) = Replace(strNewPrimary,"SMTP:","smtp:",1,1,0) Then
blnFound = True
arrEmail(i) = strNewPrimary
End If
Next
If blnFound = False Then
'Add New Primary Email If It Didn't Exist
i = UBound(arrEmail) + 1
ReDim Preserve arrEmail(i)
arrEmail(i) = strNewPrimary
End If

'Log Modified Results
Call Logger(strLog, vbCrLf & "Modified Email Addresses" & vbCrLf & "------------------------------", False)
For i = LBound(arrEmail) to UBound(arrEmail)
Call Logger(strLog, arrEmail(i), False)
Next

'Write Results
objUser.PutEx ADS_PROPERTY_UPDATE, "proxyAddresses", arrEmail
objUser.SetInfo
Call Logger(strLog, "mail=" & Replace(strNewPrimary,"SMTP:","",1,1,1), False)
objUser.Put "mail", Replace(strNewPrimary,"SMTP:","",1,1,1)
objUser.SetInfo

If Err.Number <> 0 Then
Err.Clear
Call Logger(strLog, "RESULT: !~ERROR~!", False)
Else
Call Logger(strLog, "RESULT: SUCCESS", False)
End If

'Kill User Objects
Set objUser = Nothing
End If

objRecordSet.MoveNext

Loop

'Kill Search Objects
Set objConnection = Nothing
Set objCommand = Nothing

On Error Goto 0

End Function

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

 

Apr 01

EmailParts.vbs

'=========================================================================
' EmailParts.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 4/1/2012
' COMMENTS: Four methods to break an email address into the local and
' domain parts. I prefer the string methods because you can make them
' 1-liners, doesn't require additional variables, and simplifies error
' handling.  
'=========================================================================
Option Explicit

Call EmailParts1("john.doe@domain.com")
Call EmailParts2("john.doe@domain.com")
Call EmailParts3("john.doe@domain.com")
Call EmailParts4("john.doe@domain.com")

'METHOD1(String) - Left/Right with Instr
Sub EmailParts1(email)
    Wscript.Echo "METHOD 1:" &amp; vbCrLf &amp; _
    "Email: " &amp; email &amp; vbCrLf &amp; _
    "Local: " &amp; Left(email,InStr(1,email,"@",1)-1) &amp; vbCrLf &amp; _
    "Domain: " &amp; Right(email,(Len(email)-InStr(1,email,"@",1))+1)  
End Sub

'METHOD2(String) - Left/Right with InstrRev
Sub EmailParts2(email)
    Wscript.Echo "METHOD 2:" &amp; vbCrLf &amp; _
    "Email: " &amp; email &amp; vbCrLf &amp; _
    "Local: " &amp; Left(email,InstrRev(email,"@")-1) &amp; vbCrLf &amp; _
    "Domain: " &amp; Right(email,(Len(email)-Instr(email,"@"))+1)
End Sub

'METHOD3(String) - Mid with InStr
Sub EmailParts3(email)
    Wscript.Echo "METHOD 3:" &amp; vbCrLf &amp; _
    "Email: " &amp; email &amp; vbCrLf &amp; _
    "Local: " &amp; Mid(email, 1, InStr(email, "@")-1) &amp; vbCrLf &amp; _
    "Domain: " &amp; Mid(email,InStr(email,"@"),Len(email)-(InStr(email,"@")-1))
End Sub

'METHOD4(Array) - Split dumps into an array (NOT RECOMMENDED)
Sub EmailParts4(email)
    Dim arrEmail: arrEmail = Split(email,"@")
    arrEmail(1) = "@" &amp; arrEmail(1) 'Need to add @ back in
    Wscript.Echo "METHOD 4:" &amp; vbCrLf &amp; _
    "Email: " &amp; email &amp; vbCrLf &amp; _
    "Local: " &amp; arrEmail(0) &amp; vbCrLf &amp; _
    "Domain: " &amp; arrEmail(1)
End Sub

 

Apr 01

GoogleSitemap.vbs

'=========================================================================
' GoogleSitemap.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 4/1/2012
' COMMENTS: Traverse a local website root folder and generates a Google
' Sitemap .xml file based on the folder structure. Modify the variables
' in the settings section accordingly. The variables are explained below:
' conLocalRoot - Local Website Root Folder
' conSitemap - Google Sitemap XML file to output
' conDefaultChangeFreq - Default Change Frequency for Sitemap
' conDefaultPriority - Default Priority for Sitemap
' blnSortAtoZ - Option to sort the sitemap alphabetically
' arrValidFileExtension - list of Valid file extensions to include int he sitemap
' arrDefaultDocument - list of valid default document names which are not added to the sitemap
' arrExcludedFolder - List of folders to exclude from the sitemap
' arrExcludedFile - List of file names to exclude from the sitemap
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Const conLocalRoot = "C:\inetpub\wwwroot\"
Const conSitemap = "C:\inetpub\wwwroot\sitemap.xml"
Const conWebsiteFQDN = "http://www.domain.com/"
Const conDefaultChangefreq = "monthly"
Const conDefaultPriority = "0.5"
Const blnSortAtoZ = False
Dim arrValidFileExtension: arrValidFileExtension = array("php","asp","aspx","htm","html","shtml")
Dim arrDefaultDocument: arrDefaultDocument = array("index.php","index.asp","index.aspx","index.htm","index.html","index.shtml")
Dim arrExcludedFolder: arrExcludedFolder = array("_includes","css","images")
Dim arrExcludedFile: arrExcludedFile = array("404.php")
' ------ END CONFIGURATION ------

'Validate Arrays
Dim blnValidFileExtensionIsArray: blnValidFileExtensionIsArray = False
Dim blnDefaultDocumentIsArray: blnDefaultDocumentIsArray = False
Dim blnExcludedFolderIsArray: blnExcludedFolderIsArray = False
Dim blnExcludedFileIsArray: blnExcludedFileIsArray = False
If IsArray(arrValidFileExtension) Then
    blnValidFileExtensionIsArray = True
End If
If IsArray(arrDefaultDocument) Then
    blnDefaultDocumentIsArray = True
End If
If IsArray(arrExcludedFolder) Then
    blnExcludedFolderIsArray = True
End If
If IsArray(arrExcludedFile) Then
    blnExcludedFileIsArray = True
End If

'Crawl Local Webroot Folder
Dim arrResults()
Call CrawlFolder(conLocalRoot, 0, arrResults)

'Optionally Sort Results Array - Maybe Move this
If blnSortAtoZ = True Then
    Call BubbleSort(arrResults)
End If

'Write Sitemap XML File
WriteSiteMap(arrResults)

'End Script
Wscript.Echo "Finished"

Private Function CrawlFolder(FolderToCrawl, intFiles, ByRef arrFiles)

    'Start Crawling Folder
   Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objFolder: Set objFolder = objFSO.GetFolder(FolderToCrawl) 
    Dim blnFolderIsExcluded: blnFolderIsExcluded = False

    'Check If We Should Exclude This Folder
    If blnExcludedFolderIsArray = True Then
        Dim strExcludedFolder
        For Each strExcludedFolder in arrExcludedFolder
            If StrComp(objFolder.Name,strExcludedFolder,1) = 0 Then
                blnFolderIsExcluded = True
            End If
        Next
    End If

    'Parse Files in Folder
   If blnFolderIsExcluded = False Then

        Dim objFiles: Set objFiles = objFolder.Files
        Dim objFile, strResult
        Dim strDefaultDocument, strValidFileExtension, strExcludedFile
        Dim blnFileIsExcluded, blnFileExtensionIsValid, blnDefaultDocument

        For Each objFile In objFiles

            blnFileIsExcluded = False
            blnFileExtensionIsValid = False
            blnDefaultDocument = False
            strResult = ""

            'Check If We Should Exclude This File
            If blnExcludedFileIsArray = True Then
                For Each strExcludedFile in arrExcludedFile
                    If StrComp(objFile.Name,strExcludedFile,1) = 0 Then
                        blnFileIsExcluded = True
                    End If
                Next
            End If

            'Check If We Should Exclude This File Extension
            If blnValidFileExtensionIsArray = True Then
                For Each strValidFileExtension in arrValidFileExtension
                    If StrComp(objFSO.GetExtensionName(objFile.Name),strValidFileExtension,1) = 0 Then
                        blnFileExtensionIsValid = True
                    End If
                Next
            End If             

            If blnFileIsExcluded = False AND blnFileExtensionIsValid = True Then
                strResult = objFile.Path
                ReDim Preserve arrFiles(intFiles)
                arrFiles(intFiles) = strResult
                intFiles = intFiles + 1
            End If
        Next

        'Crawl Subfolders
        Dim objSubFolder
        For Each objSubFolder In objFolder.SubFolders
            Call CrawlFolder(objSubFolder.Path, intFiles, arrResults)
        Next

    End If

    CrawlFolder = arrFiles

    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objFiles = Nothing

End Function

Private Sub WriteSiteMap(arrSites)

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.FileExists(conSitemap) Then
        Dim strPath, strUrl, objNodeLoc, objNodeLastmod
        Dim xmlDoc: Set xmlDoc = CreateObject("Microsoft.XMLDOM")
        xmlDoc.preserveWhiteSpace = False
        xmlDoc.Async = False
        Dim arrAppend()
        Dim intAppend: intAppend = 0
        If xmlDoc.Load(conSitemap) Then
            For Each strPath in arrSites
                strUrl = ConvertLocalPathToUrl(strPath)
                Set objNodeLoc = xmlDoc.selectSingleNode("/urlset/url " &amp; "[loc = '" &amp; strUrl &amp; "']")
                If Not objNodeLoc Is Nothing then
                    'Found a Match Update the Date
                    Set objNodeLastmod = xmlDoc.selectSingleNode("/urlset/url " &amp; "[loc = '" &amp; strURL &amp; "']/lastmod")
                    If Not objNodeLastmod Is Nothing Then  
                        objNodeLastmod.Text = GetDate(objFSO.GetFile(strPath).DateLastModified)
                    End If
                    xmlDoc.Save conSitemap
                Else
                    'Append URL to sitemap.xml
                    Dim objRoot: Set objRoot = xmlDoc.documentElement
                    Dim objRecord: Set objRecord = xmlDoc.createElement("url")
                    'objRecord.setAttribute "xmlns", "http://www.sitemaps.org/schemas/sitemap/0.9")
                    objRoot.appendChild objRecord
                    Dim objFieldValue
                    'Location
                    Set objFieldValue = xmlDoc.createElement("loc")
                    objFieldValue.Text = strUrl
                    objRecord.appendChild objFieldValue
                    'Last Modified
                    Set objFieldValue = xmlDoc.createElement("lastmod")
                    objFieldValue.Text = GetDate(objFSO.GetFile(strPath).DateLastModified)
                    objRecord.appendChild objFieldValue
                    'Change Frequency
                    Set objFieldValue = xmlDoc.createElement("lastmod")
                    objFieldValue.Text = conDefaultChangefreq
                    objRecord.appendChild objFieldValue
                    'Priority
                    Set objFieldValue = xmlDoc.createElement("lastmod")
                    objFieldValue.Text = conDefaultPriority
                    objRecord.appendChild objFieldValue                
                    'Save Sitemap.xml
                    xmlDoc.Save conSitemap
                End If
            Next       
        Else
            Wscript.Echo "Error Loading sitemap.xml Or sitemap.xml is NOT valid XML"
        End If
        'Cheap Hack to Cleanup Appends
        Set xmlDoc = Nothing
        Dim objTextFile: Set objTextFile = objFSO.OpenTextFile(conSitemap, 1)
        Dim strText: strText = objTextFile.ReadAll
        objTextFile.Close
        strText = Replace(strText," xmlns=" &amp; chr(34) &amp; chr(34),"")
        Set objTextFile = objFSO.OpenTextFile(conSitemap, 2)
        objTextFile.Write strText
        objTextFile.Close
    Else
        'Make New Sitemap File
        Call Logger(conSitemap,"&lt;?xml version=" &amp; chr(34) &amp; "1.0" &amp; chr(34) &amp; " encoding=" &amp; chr(34) &amp; "UTF-8" &amp; chr(34) &amp; "?&gt;",True)
        Call Logger(conSitemap,"&lt;urlset xmlns=" &amp; chr(34) &amp; "http://www.sitemaps.org/schemas/sitemap/0.9" &amp; chr(34) &amp; "&gt;",False)
        Dim strLoc
        For Each strLoc in arrSites
            Call Logger(conSitemap,vbTab &amp; "&lt;url&gt;",False)
            Call Logger(conSitemap,vbTab &amp; vbTab &amp; "&lt;loc&gt;" &amp; ConvertLocalPathToUrl(strLoc) &amp; "&lt;/loc&gt;",False)
            Call Logger(conSitemap,vbTab &amp; vbTab &amp; "&lt;lastmod&gt;" &amp; GetDate(objFSO.GetFile(strLoc).DateLastModified) &amp; "&lt;/lastmod&gt;",False)
            Call Logger(conSitemap,vbTab &amp; vbTab &amp; "&lt;changefreq&gt;" &amp; conDefaultChangefreq &amp; "&lt;/changefreq&gt;",False)
            Call Logger(conSitemap,vbTab &amp; vbTab &amp; "&lt;priority&gt;" &amp; conDefaultPriority &amp; "&lt;/priority&gt;",False)
            Call Logger(conSitemap,vbTab &amp; "&lt;/url&gt;",False)
        Next
        Call Logger(conSitemap,"&lt;/urlset&gt;",False)
    End If

    Set objFSO = Nothing

End Sub

Private Function ConvertLocalPathToUrl(strPath)

    'Check If File is Default Document
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim strDefaultDocument
    Dim blnDefaultDocument: blnDefaultDocument = False
    If blnDefaultDocumentIsArray = True Then
        For Each strDefaultDocument in arrDefaultDocument
            If StrComp(objFSO.GetFileName(strPath),strDefaultDocument,1) = 0 Then
                blnDefaultDocument = True
            End If
        Next
    End If

    'Return Results
    Dim strResult: strResult = ""
    strResult = Replace(strPath,conLocalRoot,conWebsiteFQDN,1,1,1)
    strResult = Replace(strResult,"\","/")
    If blnDefaultDocument = True Then
        strResult = Replace(strResult,objFSO.GetFileName(strPath),"")
    End If

    ConvertLocalPathToUrl = strResult

    Set objFSO = Nothing

End Function

Private Function BubbleSort(ByRef arrValues)

    Dim j, k, Temp
    For j = 0 To UBound(arrValues) - 1
        For k = j + 1 To UBound(arrValues)
            If (arrValues(j) &gt; arrValues(k)) Then
                Temp = arrValues(j)
                arrValues(j) = arrValues(k)
                arrValues(k) = Temp
            End If
        Next
    Next

    BubbleSort = arrValues

End Function

Private Function GetDate(strDate)

    'Ensure Valid Date
    If Not IsDate(strDate) Then
        strDate = Date
    End If

    Dim strYear: strYear = Year(strDate)
    Dim strMonth: strMonth = Month(strDate)
    Dim strDay: strDay = Day(strDate)
    If strMonth &lt; 10 Then
        strMonth = 0 &amp; strMonth
    End If
    If strDay &lt; 10 Then
        strDay = 0 &amp; strDay
    End If

    GetDate = strYear &amp; "-" &amp; strMonth &amp; "-" &amp; strDay

End Function

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) &gt; 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 &amp; 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

 

Jan 01

EnumerateComputersByOU.vbs

'=========================================================================
' EnumerateComputersByOU.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass the ADsPath or Dinstinguised Name of the Container/Organizational
' Unit to the Function, and it'll return all of the Computers Within.
' EXAMPLE: strCompPath = "LDAP://CN=Computers,DC=domain,DC=com"
'          strCompPath = "CN=Computers,DC=domain,DC=com"
'          strCompPath = "LDAP://OU=Computer,DC=domain,DC=com"
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strCompPath: strCompPath = "LDAP://CN=Computers,DC=domain,DC=com"
' ------ END CONFIGURATION ------

Call Logger("EnumerateComputersByOU.txt", EnumerateComputersByOU(strCompPath), True)
Wscript.Echo "Finished"

Private Function EnumerateComputersByOU(computerPath)

    On Error Resume Next

    computerPath = Replace(computerPath,"LDAP://","",1,1,1) 'Ensure DN not ADS Path
    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://" & computerPath & "' WHERE objectCategory='computer'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Dim strResult: strResult = ""
    Do Until objRecordSet.EOF
        strResult = strResult & objRecordSet.Fields("AdsPath").Value & vbCrLf
        objRecordSet.MoveNext
    Loop

    EnumerateComputersByOU = strResult

    On Error Goto 0

End Function

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

 

Jan 01

ListComputerOS.vbs

'=========================================================================
' ListComputerOS.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass the ADsPath or Distinguished Name of the Computer Object or
' Container/Organizational Unit to the Function, and it'll return the Computer Name
' and Operating System as Listed In Active Directory.
' EXAMPLE: strUserPath = "LDAP://CN=Computers,DC=domain,DC=com"
'          strUserPath = "CN=Computers,DC=domain,DC=com"
'          strUserPath = "LDAP://OU=Computer,DC=domain,DC=com"
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strUserPath: strUserPath = "LDAP://CN=Computers,DC=domain,DC=com"
' ------ END CONFIGURATION ------

Call Logger("ListComputerOS.txt", ListComputerOS(strUserPath), True)
Wscript.Echo "Finished"

Private Function ListComputerOS(computerPath)

    On Error Resume Next

    computerPath = Replace(computerPath,"LDAP://","",1,1,1) 'Ensure DN not ADsPath
    Dim strResult: strResult = ""

    'Query Computers
    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, OperatingSystem FROM 'LDAP://" & computerPath & "' WHERE objectCategory='computer'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        strResult = strResult & objRecordSet.Fields("ADsPath").Value & vbTab & objRecordSet.Fields("OperatingSystem").Value & vbCrLf
        objRecordSet.MoveNext
    Loop

    'Check For Errors
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "Computer:" & strComputer & vbTab & "Count:!~ERROR~!" & vbTab & "User:!~ERROR~!"
    End If

    'Return Result
    ListComputerOS = strResult

    On Error Goto 0

End Function

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

 

Jan 01

EnumerateContactsByOU.vbs

'=========================================================================
' EnumerateContactsByOU.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass the ADsPath or Dinstinguised Name of the Container/Organizational
' Unit to the Function, and it'll return all of the Contacts Within.
' EXAMPLE: strContactPath = "LDAP://CN=Users,DC=domain,DC=com"
'          strContactPath = "CN=Users,DC=domain,DC=com"
'          strContactPath = "LDAP://OU=Contacts,DC=domain,DC=com"
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strContactPath: strContactPath = "LDAP://CN=Users,DC=domain,DC=com"
' ------ END CONFIGURATION ------

Call Logger("EnumerateContactsByOU.txt", EnumerateContactsByOU(strContactPath), True)
Wscript.Echo "Finished"

Private Function EnumerateContactsByOU(contactPath)

    On Error Resume Next    'Start Error Handling

    contactPath = Replace(contactPath,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    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://" & contactPath & "' WHERE objectCategory='person' AND objectClass='contact'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Dim strResult: strResult = ""
    Do Until objRecordSet.EOF
        strResult = strResult & objRecordSet.Fields("AdsPath").Value & vbCrLf
        objRecordSet.MoveNext
    Loop

    EnumerateContactsByOU = strResult

    On Error Goto 0 'End Error Handling

End Function

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

 

Jan 01

GroupBackupRestore.vbs

'=========================================================================
' GroupBackupRestore.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: This Script Will Bulk Backup Groups to a Text File and Can Also
' Restore the Groups After a Backup.  It is Useful to Restore Accidentally
' Deleted Groups, Migrating Groups Across Domains, and For Quickly Restoring
' Settings For Temporary Modifications Such as Removing and Restoring Message
' Restrictions. Parts of this Script Require Exchange DLL's like CDOEXM.DLL,
' So It's Recommended to Run on a Computer with Exchange Tools Installed.
'
' To Backup Groups, Pass the ADsPath or Dinstinguised Name of the
' Container/Organizational Unit to the RunBackup Function. The Results are
' Output to backup_<Date>.txt in the Current Directory by Default. I Recommend
' Keeping the Default To Prevent Accidentally Overwriting the Backup File.
'
' To Restore Groups, Pass the Name of the Backup File to the RunRestore Function.
' By Default, the Backup File is backup_Date.txt in the Current Directory.
'
' EXAMPLE: Call RunBackup("LDAP://CN=Users,DC=domain,DC=com")
'
' EXAMPLE: Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
'          Call RunRestore(scriptPath & "backup.txt")
'=========================================================================
Option Explicit
' ------ BACKUP CONFIGURATION ------
Call RunBackup("LDAP://CN=Users,DC=domain,DC=com")
' ------ END CONFIGURATION ------

' ------ RESTORE CONFIGURATION ------
'Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
'Call RunRestore(scriptPath & "backup.txt")
' ------ END CONFIGURATION ------

Wscript.Echo "Finished"

'**************************************************************************************************
'Sub RunBackup - Specify Root Search OU to Enumerate All Groups to Backup
'**************************************************************************************************
Private Sub RunBackup(strOU)

    On Error Resume Next

    strOU = Replace(strOU,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Const ADS_SCOPE_SUBTREE = 2
    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
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE    'Include Sub OU's
    objCommand.CommandText = "SELECT distinguishedname FROM 'LDAP://" & strOU & "' WHERE objectClass='group'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    If Err.Number <> 0 Then
        Wscript.Echo "!~ERROR~! Running Backup!" & vbCrLf & "Invalid OU: " & strOU & vbCrLf & vbCrLf & "Quitting Script"
        Err.Clear
        Wscript.Quit
    End If
    Dim strDate: strDate = Day(Now) & Month(Now) & Year(Now) & Hour(Now) & Minute(Now) & Second(Now)
    Call Logger("backup_" & strDate & ".txt","", True)
    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        'Backup Groups
        Call Logger("backup_" & strDate & ".txt",BackupGroup(objRecordSet.Fields("distinguishedname").Value), False)
        objRecordSet.MoveNext
    Loop

    On Error Goto 0

End Sub

'**************************************************************************************************
'Function BackupGroup - Specify the Group Distinguished Name and Backs Up to backup.txt
'**************************************************************************************************
Private Function BackupGroup(groupDN)

    On Error Resume Next

    Dim strResult: strResult = "[group]" & vbCrLf & "group|" & groupDN
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    strResult = strResult & vbCrLf & "name|" & objGroup.CN
    strResult = strResult & vbCrLf & "samaccountname|" & objGroup.sAMAccountName

    Const ADS_GROUP_TYPE_GLOBAL_GROUP = &h2
    Const ADS_GROUP_TYPE_LOCAL_GROUP = &h4
    Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h8
    Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000
    Dim intgroupType: intgroupType = objGroup.groupType
    If intGroupType AND ADS_GROUP_TYPE_LOCAL_GROUP Then
        strResult = strResult & vbCrLf & "scope|Domain Local"
    ElseIf intGroupType AND ADS_GROUP_TYPE_GLOBAL_GROUP Then
        strResult = strResult & vbCrLf & "scope|Global"
    ElseIf intGroupType AND ADS_GROUP_TYPE_UNIVERSAL_GROUP Then
        strResult = strResult & vbCrLf & "scope|Universal"
    Else
        strResult = strResult & vbCrLf & "scope|Unknown"
    End If
    If intGroupType AND ADS_GROUP_TYPE_SECURITY_ENABLED Then
        strResult = strResult & vbCrLf & "type|Security"
    Else
        strResult = strResult & vbCrLf & "type|Distribution"
    End If

    strResult = strResult & vbCrLf & "mail|" & objGroup.mail
    strResult = strResult & vbCrLf & "displayname|" & objGroup.displayName

    Dim strManagedBy: strManagedBy = objGroup.Get("managedBy")
    If Err.Number <> 0 Then
        strResult = strResult & vbCrLf & "manager|None"
        Err.Clear
    Else
        strResult = strResult & vbCrLf & "manager|" & strManagedBy
    End If

    Dim objMember
    For Each objMember in objGroup.Members
        strResult = strResult & vbCrLf & "member|" & objMember.distinguishedName
    Next

    Const cdoexmAccept = 0
    Const cdoexmReject = 1
    Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D
    If Not objGroup.Mail = "" Then
        If objGroup.msExchRequireAuthToSendTo = True Then
            strResult = strResult & vbCrLf & "authentication|True"
        Else
            strResult = strResult & vbCrLf & "authentication|False"
        End If
        If IsNull(objGroup.RestrictedAddressList) OR UBound(objGroup.RestrictedAddressList) < 0 Then
            strResult = strResult & vbCrLf & "Restriction|from everyone"
        Else
            If objGroup.RestrictedAddresses = cdoexmAccept Then
                strResult = strResult & vbCrLf & "festriction|only from"
            Else
                strResult = strResult & vbCrLf & "restriction|from everyone except"
            End If
            For Each objMember in objGroup.RestrictedAddressList
                strResult = strResult & vbCrLf & "restrict|" & objMember
            Next
        End If
    End If

    If Err.Number <> 0 Then
        strResult = "[group]" & vbCrLf & "group|" & groupDN & vbCrLf & "!~ERROR~!"
        Err.Clear
    End If
    BackupGroup = strResult & vbCrLf & "[end]" & vbCrLf

    On Error Goto 0

End Function

'**************************************************************************************************
'Sub Run Restore - Restores Groups From the Specified Backup File
'**************************************************************************************************
Private Sub RunRestore(backupFile)

    On Error Resume Next

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Const ForReading = 1
    If Not objFSO.FileExists(backupFile) Then
        Wscript.Echo "!~ERROR~! Running Restore!" & vbCrLf & "Backup File: " & backupFile & vbCrLf & vbCrLf & "Quitting Script"
        Wscript.Quit
    End If
    Call Logger("restore.txt", "", True)
    Dim objTextFile: Set objTextFile = objFSO.OpenTextFile(backupFile, ForReading)
    Dim strLine
    Dim strGroup, strName, strSamaccountname, strScope, strType, strMail, strDisplayName, strManager, i
    Dim strAuth, strRestriction, j
    Dim arrMember(), arrRestrict()
    Do Until objTextFile.AtEndOfStream
        strLine = objTextFile.Readline
        If StrComp(Mid(strLine,1,7),"[group]",1) = 0 Then
            'Reset Variables
            strGroup = ""
            strName = ""
            strSamaccountname = ""
            strScope = ""
            strType = ""
            strMail = ""
            strDisplayName = ""        
            strManager = ""
            i = 0
            strAuth = ""
            strRestriction = ""
            j = 0
            Erase arrMember
            Erase arrRestrict
            Call Logger("restore.txt", "[group]", False)   
        Elseif StrComp(Mid(strLine,1,6),"group|",1) = 0 Then
            strGroup = Mid(strLine,7,Len(strLine)-6)           
        Elseif StrComp(Mid(strLine,1,5),"name|",1) = 0 Then
            strName = Mid(strLine,6,Len(strLine)-5)
        Elseif StrComp(Mid(strLine,1,15),"samaccountname|",1) = 0 Then
            strSamaccountname = Mid(strLine,16,Len(strLine)-15)
        Elseif StrComp(Mid(strLine,1,6),"scope|",1) = 0 Then
            strScope = Mid(strLine,7,Len(strLine)-6)
        Elseif StrComp(Mid(strLine,1,5),"type|",1) = 0 Then
            strType = Mid(strLine,6,Len(strLine)-5)
        Elseif StrComp(Mid(strLine,1,5),"mail|",1) = 0 Then
            strMail = Mid(strLine,6,Len(strLine)-5)    
        Elseif StrComp(Mid(strLine,1,12),"displayname|",1) = 0 Then
            strDisplayName = Mid(strLine,13,Len(strLine)-12)
        Elseif StrComp(Mid(strLine,1,8),"manager|",1) = 0 Then
            strManager = Mid(strLine,9,Len(strLine)-8)
        Elseif StrComp(Mid(strLine,1,7),"member|",1) = 0 Then
            'blnUsers = True           
            ReDim Preserve arrMember(i)
            arrMember(i) = Mid(strLine,8,Len(strLine)-7)
            i = i + 1
        Elseif StrComp(Mid(strLine,1,15),"authentication|",1) = 0 Then
            If StrComp(Trim(Mid(strLine,16,Len(strLine)-15)),"true",1) = 0 Then
                strAuth = True
            Else
                strAuth = False
            End If
        Elseif StrComp(Mid(strLine,1,12),"restriction|",1) = 0 Then
            strRestriction = Mid(strLine,13,Len(strLine)-12)
        Elseif StrComp(Mid(strLine,1,9),"restrict|",1) = 0 Then
            ReDim Preserve arrRestrict(j)
            arrRestrict(j) = Mid(strLine,10,Len(strLine)-9)
            j = j + 1
        Elseif StrComp(Mid(strLine,1,5),"[end]",1) = 0 Then
            'Ensure Group Exists
            If CheckObjExist(strGroup) Then
                Call Logger("restore.txt", "Exists" & vbTab & "group|" & strGroup, False)
            Else
                If CreateGroup(strGroup, strSamaccountname, strScope & " " & strType, strMail, strDisplayname) = True Then
                    Call Logger("restore.txt", "Added" & vbTab & "group|" & strGroup, False)
                Else
                    Call Logger("restore.txt", "!~ERROR~!" & vbTab & "group|" & strGroup, False)
                End If
            End If

            'Ensure Manager is Set
            If strComp(strManager,"None",1) = 0 Then
                Call Logger("restore.txt", "Skip" & vbTab & "manager|" & strManager, False)
            Else
                If CheckGroupManager(strGroup,strManager) = True Then
                    Call Logger("restore.txt", "Exists" & vbTab & "manager|" & strManager, False)
                Else
                    If ModifyGroupManager(strGroup,strManager) = True Then
                        Call Logger("restore.txt", "Modified" & vbTab & "manager|" & strManager, False)
                    Else
                        Call Logger("restore.txt", "!~ERROR~!" & vbTab & "manager|" & strManager, False)
                    End If
                End If             
            End If

            'Ensure all Members are a member
            For i = LBound(arrMember) to UBound(arrMember)
                If Err.Number <> 0 Then
                    Err.Clear
                    Call Logger("restore.txt", "SKIP" & vbTab & "member|none", False)
                Else
                    'Ensure User Exists
                    If CheckObjExist(arrMember(i)) Then
                        'Check if User is A member of The Group
                        If CheckUserInGroup(arrMember(i),strGroup) = True Then
                            Call Logger("restore.txt", "Exists" & vbTab & "member|" & arrMember(i), False)
                        Else
                            'User Not a Member, Try to Add User to Group
                            If AddUserToGroup(arrMember(i),strGroup) = True Then
                                Call Logger("restore.txt", "Added" & vbTab & "member|" & arrMember(i), False)
                            Else
                                Call Logger("restore.txt", "!~ERROR~!" & vbTab & "member|" & arrMember(i), False)
                            End If
                        End If
                    Else
                        Call Logger("restore.txt", "!~ERROR~!" & vbTab & "member|" & arrMember(i), False)
                    End If
                End If
            Next

            'Ensure Restrictions Are Set
            If Not strRestriction = "" Then
                'Set Authentication
                If RestoreAuthentication(strGroup, strAuth) = True Then
                    Call Logger("restore.txt", "Modified" & vbTab & "authentication|" & strAuth, False)
                Else
                    Call Logger("restore.txt", "!~ERROR~!" & vbTab & "authentication|" & strAuth, False)
                End If
                'Restore Restriction Type and List
                If RestoreRestrictions(strGroup, strRestriction, arrRestrict) = True Then
                    Call Logger("restore.txt", "Modified" & vbTab & "restriction|" & strRestriction, False)
                    For j = LBound(arrRestrict) to UBound(arrRestrict)
                        Call Logger("restore.txt", "Added" & vbTab & "restrict|" & arrRestrict(j), False)
                    Next
                Else
                    Call Logger("restore.txt", "!~ERROR~!" & vbTab & "restriction|" & strRestriction, False)
                    For j = LBound(arrRestrict) to UBound(arrRestrict)
                        Call Logger("restore.txt", "!~ERROR~!" & vbTab & "restrict|" & arrRestrict(j), False)
                    Next
                End If
            End If
        Else
            'Ignore All other lines
        End If

    Loop

    On Error Goto 0

End Sub

'**************************************************************************************************
'Function CheckObjExist - Checks If An Object Exists in AD by Trying to Bind to It
'**************************************************************************************************
Private Function CheckObjExist(objDN)

    On Error Resume Next

    Dim adObject: Set adObject = GetObject("LDAP://" & objDN)
    If Err.Number <> 0 Then
        CheckObjExist = FALSE
        Err.Clear
    Else
        CheckObjExist = TRUE
    End If

    On Error Goto 0

End Function

'**************************************************************************************************
'Function CreateGroup - Creates Group Based on Passed in Parameters -MUST BE RUN ON EXCHANGE SERVER!
'**************************************************************************************************
Private Function CreateGroup(groupDN, strSamAccountName, scopeType, strMail, strDisplayname)

    On Error Resume Next

    'Create Group
    Const ADS_GROUP_TYPE_GLOBAL_GROUP = &h2
    Const ADS_GROUP_TYPE_LOCAL_GROUP = &h4
    Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h8
    Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000
    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objOU: Set objOU = GetObject("LDAP://" & Right(groupDN,Len(groupDN)-InStr(1,groupDN,",",1)))
    Dim objGroup: Set objGroup = objOU.Create("Group", Left(groupDN,InStr(1,groupDN,",",1)-1))
    objGroup.Put "sAMAccountName", strSamAccountName
    Select Case scopeType
        Case "Domain Local Distribution"
            objGroup.Put "groupType", ADS_GROUP_TYPE_LOCAL_GROUP
        Case "Global Security"
            objGroup.Put "groupType", ADS_GROUP_TYPE_GLOBAL_GROUP Or ADS_GROUP_TYPE_SECURITY_ENABLED
        Case "Universal Distribution"
            objGroup.Put "groupType", ADS_GROUP_TYPE_UNIVERSAL_GROUP
        Case "Universal Security"
            objGroup.Put "groupType", ADS_GROUP_TYPE_UNIVERSAL_GROUP Or ADS_GROUP_TYPE_SECURITY_ENABLED        
    End Select
    objGroup.SetInfo

    'Email Enable
    If Not Trim(strMail) = "" Then
        objGroup.Put "mail", strMail
        objGroup.Put "displayname", strDisplayname
        objGroup.MailEnable
        objGroup.SetInfo
    End If

    If Err.Number <> 0 Then
        CreateGroup = FALSE
        Err.Clear
    Else
        CreateGroup = TRUE
    End If

    On Error Goto 0

End Function

'**************************************************************************************************
'Function CheckGroupManager - Checks If the Specified User Is Set As The Manager On the Specified Group
'**************************************************************************************************
Private Function CheckGroupManager(groupDN,managerDN)

    On Error Resume Next

    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    Dim strManagedBy: strManagedBy = objGroup.Get("managedBy")
    Dim strResult: strResult = FALSE
    If Err.Number <> 0 Then
        Err.Clear
    Else
        If strComp(strManagedBy,managerDN,1) = 0 Then
            strResult = TRUE
        End If
    End If
    CheckGroupManager = strResult

    On Error Goto 0

End Function

'**************************************************************************************************
'Function ModifyGroupManager - Sets Specified User As Group Manager On The Specified Group
'**************************************************************************************************
Private Function ModifyGroupManager(groupDN,managerDN)

    On Error Resume Next

    'Set Group Manager
    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    managerDN = Replace(managerDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    objGroup.Put "managedBy", managerDN
    objGroup.SetInfo

    'Allow Manager to Update Member List
    Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5
    Const ADS_FLAG_OBJECT_TYPE_PRESENT = &H01
    Const ADS_RIGHT_DS_WRITE_PROP = &H20
    Const ADS_OBJECT_WRITE_MEMBERS = "{BF9679C0-0DE6-11D0-A285-00AA003049E2}"
    Const ADS_ACEFLAG_INHERIT_ACE = &H00002
    Const ADS_ACEFLAG_DONT_INHERIT_ACE = &H0
    Dim objRootDSE: Set objRootDSE = GetObject("LDAP://rootDSE")
    Dim strDomain: strDomain = "LDAP://" & objRootDSE.Get("defaultNamingContext")
    Dim objDomain: Set objDomain = GetObject(strDomain)
    Dim objUser: Set objUser = GetObject("LDAP://" & objGroup.Get("managedBy"))
    Dim objSecurityDescriptor: Set objSecurityDescriptor = objGroup.Get("ntSecurityDescriptor")
    Dim objDACL: Set objDACL = objSecurityDescriptor.DiscretionaryACL
    Dim objACE: Set objACE = CreateObject("AccessControlEntry")
    objACE.Trustee = Replace(objDomain.Name,"DC=","",1,1,1) & "\" & 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
        ModifyGroupManager = FALSE
        Err.Clear
    Else
        ModifyGroupManager = TRUE
    End If

    On Error Goto 0

End Function

'**************************************************************************************************
'Function CheckUserInGroup - Checks If Specified User Is a Member of The Specified Group
'**************************************************************************************************
Private Function CheckUserInGroup(userDN,groupDN)

    On Error Resume Next

    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    userDN = Replace(userDN,"LDAP://","",1,1,1) 'Ensure DN not ADS Path
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    Dim objMember
    Dim strResult: strResult = FALSE
    For Each objMember in objGroup.Members
        If strComp(objMember.distinguishedName, userDN,1) = 0 Then
            strResult = TRUE
        End If
    Next

    CheckUserInGroup = strResult

    On Error GoTo 0

End Function

'**************************************************************************************************
'Function AddUserToGroup - Adds Specified User to Specified Group
'**************************************************************************************************
Private Function AddUserToGroup(userDN,groupDN)

    On Error Resume Next

    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    userDN = Replace(userDN,"LDAP://","",1,1,1) 'Ensure DN not ADS Path
    Dim objUser: Set objUser = GetObject("LDAP://" & userDN)
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    objGroup.Add(objUser.ADsPath)
    If Err.Number <> 0 Then
        AddUserToGroup = FALSE
    Else
        AddUserToGroup = TRUE
    End If

    On Error GoTo 0

End Function

'**************************************************************************************************
'Function RestoreAuthentication - Enable/Disable Accept Messages From Authenticated Users Only On
'                                 an Email Enabled Group
'**************************************************************************************************
Private Function RestoreAuthentication(groupDN, blnAuth)

    On Error Resume Next

    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    objGroup.msExchRequireAuthToSendTo = blnAuth
    objGroup.SetInfo

    If Err.Number <> 0 Then
        RestoreAuthentication = FALSE
    Else
        RestoreAuthentication = TRUE
    End If

    On Error GoTo 0

End Function

'**************************************************************************************************
'Function RestoreRestrictions - Sets Restriction Type and Restriction Lists On Email Enabled Groups
'**************************************************************************************************
Private Function RestoreRestrictions(groupDN, restrictionType, arrMembers)

    On Error Resume Next

    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    Const cdoexmAccept = 0
    Const cdoexmReject = 1
    If StrComp(Trim(restrictionType),"from everyone",1) = 0 Then
        objGroup.RestrictedAddresses = cdoexmAccept
    Elseif StrComp(Trim(restrictionType),"only from",1) = 0 Then
        objGroup.RestrictedAddresses = cdoexmAccept
    Elseif StrComp(Trim(restrictionType),"from everyone except",1) Then
        objGroup.RestrictedAddresses = cdoexmReject
    End If
    objGroup.RestrictedAddressList = arrMembers
    objGroup.SetInfo

    If Err.Number <> 0 Then
        RestoreRestrictions = FALSE
    Else
        RestoreRestrictions = TRUE
    End If

    On Error GoTo 0

End Function

'**************************************************************************************************
'Sub Logger - Specify Log Name, Message, and If It Should Make a New Log or Append an Existing Log
'**************************************************************************************************
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