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

 

Leave a Reply

Your email address will not be published. Required fields are marked *