Subroutines

VBScript subroutines are used to perform a dedicated process, usually involving input parameters.

ExitMe

This subroutine sets some common objects to nothing, writes final log entry, exits.

Sub ExitMe (ByVal intExitCode)
'*********************************************************************************************
'* Sub ExitMe (ByVal intExitCode)
'* Purpose: sets objects to nothing, writes final log entry, exits
'*********************************************************************************************

    Call WriteOutput ("Exit Code = " & intExitCode, 0, "INFO")
    Call WriteOutput ("************** Complete " & strShortScriptName & "-" & strVersion & " ************", 0, "INFO")
    Call WriteOutput ("", 0, "TRACE")

    '* Pause for 5 seconds to display
    Call Pause("5")

    '* Set objects to Nothing
    Set objWshShell = Nothing    
    Set objFSO = Nothing
    Set objScriptFile = Nothing
    Set objScriptFolder = Nothing

    '* Exit script
    Call WScript.Quit (intExitCode)

End Sub

FolderPurge

This subroutine checks for and deletes old files recursively in the specified folder.

Sub FolderPurge (byVal strPath, byVal dtmLimitDateTime, byVal strRootPath, byVal strExtensions, byVal booOnlyRoot, byVal intIndent)
'*********************************************************************************************
'* Sub FolderPurge (byVal strPath, byVal dtmLimitDateTime, byVal strRootPath, byVal strExtensions, byVal booOnlyRoot, byVal intIndent)
'* Purpose: Checks for and deletes old files recursively in the specified folder.
'* strPath: full path of current folder to be purged.
'* dtmLimitDateTime: date time value that file needs to be younger than to be kept.
'* strRootPath: full path of root folder to be purged.
'* strExtensions: comma delimited list of file extensions that are to be kept, regardless of age. ".zip" is automatically added to this list
'* booOnlyRoot: boolean: TRUE if we only want to use the file extensions in the root folder.
'* intIndent: number of indents to use (for recursion logging).
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim objSubFolder, objFile, objSubDir
    Dim intDeletedFileCount
    Dim strUseExtensions, strMyExtension

    '* write log data
    Call WriteOutput ("Start FolderPurge ('" & strPath & "', "  & dtmLimitDateTime & ", '"  & strRootPath & "', "  & strExtensions & ", "  & booOnlyRoot & ", "  & intIndent & ")" , intIndent, "INFO")

    '* Check for purge folder, exit if not found
    If objFSO.FolderExists(strPath) = False then
        strErrorMessage = "FolderPurge failed: Can't find folder to purge: " & strPath

        '* write log data
        Call WriteOutput (strErrorMessage, intIndent + 1, "ERROR")

'        '* send email
'        Call SendEmail (strErrorToEmail, "", "", "VBSAutoDoc FolderPurge Error", "Folder '" & strPath & "' does not exist", intIndent + 1)

        '* cleanup and exit
        Call ExitMe (-4)     
    End If
    On Error Goto 0

    Set objSubFolder = objFSO.getfolder(strPath)
    intDeletedFileCount = 0

     'Setup extension list for if we're not in the root and "root exclusions only" is turned on
    If strPath <> strRootPath AND booOnlyRoot = True Then
        strUseExtensions = ".zip,"
    Else
        strUseExtensions = strExtensions & ",.zip,"
    End If

    '* look in the current folder for files to delete
    For Each objFile In objSubFolder.Files  
        '* get current file extension
        strMyExtension = Right(objFile.Name, len(objFile.Name) - inStrRev(objFile.Name, ".") + 1)

        '* add delimiter to file extension
        strMyExtension = strMyExtension & ","

        '* if we got an error, just skip this entry
        If Err.Number <> 0 Then   
            Err.Clear

        '* check to see if the date is old and the extension is allowed
        ElseIf objFile.DateLastModified < Cdate(dtmLimitDateTime) AND instr(strUseExtensions, strMyExtension) = 0 Then
            '* attempt to delete the file
            On Error Resume Next 
            Call objFSO.DeleteFile (objFile.Path, True)

            '* if error, report and exit
            If Err.Number <> 0 Then
                strErrorMessage = Replace(Err.Description, vbCrLf, " ")
                strErrorMessage = "Error " & Err.Number & ": " & strErrorMessage

                '* write log data
                Call WriteOutput ("FolderPurge failed: " & strErrorMessage, intIndent + 1, "ERROR")

'                '* send email
'                Call SendEmail (strErrorToEmail, "", "", "VBSAutoDoc FolderPurge Error", "Delete '" & objFile.Path & "' failed: " & strErrorMessage, intIndent + 1)

                '* exit
                Call ExitMe (-5)
            End If
            On Error Goto 0

            intDeletedFileCount = intDeletedFileCount + 1
        End If
    Next

    '* Output results of current folder
    Call WriteOutput ("Deleted " & intDeletedFileCount & " files from '" & strPath & "'", intIndent + 1, "TRACE")
    Call Pause("1")

    '* recurse the FolderPurge sub with the subdir paths
    For Each objSubDir In objSubFolder.Subfolders
        Call FolderPurge (objSubDir.Path, dtmLimitDateTime, strRootPath, strExtensions, booOnlyRoot, intIndent + 1)
    Next

    '* Set objects to Nothing
    Set objSubFolder = Nothing
    Set objFile = Nothing

    '* write log data and end sub
    Call WriteOutput ("End FolderPurge", intIndent, "INFO")
End Sub

GetEmptySubFolders

This subroutine recursively checks for and creates array of folders that have no content.

Sub GetEmptySubFolders (ByVal objFolder, ByVal intIndent)
'*********************************************************************************************
'* Sub GetEmptySubFolders (ByVal strFolder, ByVal intIndent)
'* Purpose: Recursively checks for and creates array of folders that have no content
'* objFolder: folder object to inspect for empty folders
'* intIndent: number of indents to use (for recursion logging)
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim objSubFolder

    '* write log data
    Call WriteOutput ("Start GetEmptySubFolders ('" & objFolder.Name & "', " & intIndent & ")", intIndent, "INFO")

    '* Get collection of folders in current folder
    If objFolder.SubFolders.Count > 0 Then 
        For Each objSubFolder in objFolder.SubFolders

            '* If the size of the folder is zero
            If objSubFolder.Size = 0 Then
                ReDim Preserve arrFolders(intArrayFoldersSize)
                arrFolders(intArrayFoldersSize) = objSubFolder.Path
                intArrayFoldersSize = intArrayFoldersSize + 1
                Call WriteOutput ("Subfolder '" & objSubFolder.Name & "' is empty, added to Empty Subfolder array", intIndent + 1, "DEBUG")
            Else
                Call WriteOutput ("Subfolder '" & objSubFolder.Name & "' is not empty, not added to Empty Subfolder array", intIndent + 1, "DEBUG")
            End If

            '* Call next layer of recursion
            Call GetEmptySubFolders (objSubFolder, intIndent + 1)
        Next
    Else
        Call WriteOutput ("'" & objFolder.Name & "' has no subfolders", intIndent + 1, "DEBUG")
    End If

    '* Set objects to Nothing
    Set objSubFolder = Nothing

    '* write log data and end sub
    Call WriteOutput ("End GetEmptySubFolders", intIndent, "INFO")

End Sub

InitializeLogFile

This subroutine initializes the current log file and renames the previous day's log file with a date stamp.

Sub InitializeLogFile ()
'*********************************************************************************************
'* Sub InitializeLogFile ()
'* Purpose: Initialize current log file and rename previous day's log file with date stamp
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim strTimeStamp, strLogName
    Dim dteLastModified
    Dim booLogFileNew

    '* build filename timestamp
    strTimeStamp = Cstr(Year(Date)) & Right("00" & Cstr(Month(Date)),2) & Right("00" & Cstr(Day(Date)),2) & "-" & Right("00" & Cstr(Hour(Time)),2) & Right("00" & Cstr(Minute(Time)),2) & Right("00" & Cstr(Second(Time)),2)

    '* Create file system objects, log folder if it doesn't exist
    strLogFolder = strScriptFolder & "\" & strShortScriptName & "-Logs\"
    strLogName = strLogFolder & strShortScriptName & ".log"  
    If objFSO.FolderExists(strLogFolder) = FALSE then
        Call objFSO.CreateFolder (strLogFolder)
    End If

    '* check if log file is from today, if it exists rename it with it's last mod date
    If objFSO.FileExists(strLogName) = True then
        Set objLogFile = objFSO.GetFile (strLogName)
        dteLastModified = objLogFile.DateLastModified
        Set objLogFile = Nothing

        '* Rename previous days log file to new date named log file
        If DateDiff("D", Now(), dteLastModified) <> 0 Then
            booLogFileNew = True
            Call RelocateFile (strLogName, strLogFolder & Cstr(Year(dteLastModified)) & Right("00" & Cstr(Month(dteLastModified)),2) & Right("00" & Cstr(Day(dteLastModified)),2) & "_" & strShortScriptName & ".log", True, -999)
        Else 
            booLogFileNew = False 

        End If 
    End If

    '* open log file
    Set objLogFile = objFSO.OpenTextFile(strLogName, 8, True)

End Sub

MakeDir

This subroutine create all folders in the path that don't exist.

Sub MakeDir (ByVal strPath, ByVal intIndent) 
'*********************************************************************************************
'* Sub MakeDir (ByVal strPath, ByVal intIndent)  
'* Purpose: Create all folders in path that don't exist
'* strPath: file path that needs to be checked and created
'* intIndent: number of indents to use (for recursion logging)
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim strParentPath, strErrorMessage

    '* check for path data, if empty, report and exit
    If strPath = "" Then

        '* write log data
        WriteOutput "MakeDir failed: Unable to locate server or share", intIndent + 1, "ERROR"

        '* exit
        Call ExitMe (-2)
    End if

    '* write log data
    WriteOutput "Start MakeDir ('" & strPath & "', " & intIndent & ")", intIndent, "INFO"

    On Error Resume Next

    '* get parent folder path
    strParentPath = objFSO.GetParentFolderName(strPath)

    '* if parent path not found, recursively  call this sub
    If Not objFSO.FolderExists(strParentPath) Then MakeDir strParentPath, intIndent + 1

    '* if current path not found, create it
    If Not objFSO.FolderExists(strPath) Then objFSO.CreateFolder strPath

    '* if error, report and exit
    If Err.Number <> 0 Then
        strErrorMessage = Replace(Err.Description, vbCrLf, " ")
        strErrorMessage = "Error " & Err.Number & ": " & strErrorMessage

        '* write log data
        WriteOutput "MakeDir failed: " & strErrorMessage, intIndent + 1, "ERROR"

        '* exit
        Call ExitMe (-3)
    End If    
    On Error Goto 0

    '* write log data and end sub
    WriteOutput "End MakeDir", intIndent, "INFO"

End Sub

Pause

This subroutine delays further execution by x seconds.

Sub Pause (ByVal intSeconds)
'*********************************************************************************************
'* Sub Pause (byVal intSeconds)
'* Purpose: Delay further execution by x seconds. A ping call is a very low cost method of forcing the script to pause
'*              0 seconds for first ping, then 1 second for each additional ping
'*              pinging 'localhost' avoids network traffic and should have an instantaneous response
'* intSeconds: Number of seconds to pause
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim strCommand

    '* Send pings to simulate a pause
    intSeconds = cint(intSeconds) + 1
    strCommand = "%COMSPEC% /c ping -n " & intSeconds & " 127.0.0.1>nul"
    Call objWshShell.Run (strCommand,0,1)

End Sub

RelocateFile

This subroutine moves a file.

Sub RelocateFile (ByVal strSourceFilePath, ByVal strDestinationFilePath, ByVal booDeleteFile, ByVal intIndent) 
'*********************************************************************************************
'* Sub RelocateFile (ByVal strSourceFilePath, ByVal strDestinationFilePath, ByVal booDeleteFile, ByVal intIndent) 
'* Purpose: Move a file
'* strSourceFilePath: file path and name of the file that will be copied
'* strDestinationFilePath: file path and name of the file that will be copied to
'* booDeleteFile: if the file is to be deleted as well
'* intIndent: number of indents to use (for recursion logging)
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim strErrorMessage

    '* write log data
    Call WriteOutput ("Start RelocateFile ('" & strSourceFilePath & "', '" & strDestinationFilePath & "', " & booDeleteFile & ", " & intIndent & ")", intIndent, "INFO")

    '* attempt to copy file
    On Error Resume Next 
    Call objFSO.CopyFile (strSourceFilePath, strDestinationFilePath)

    '* if error, report and exit
    If Err.Number <> 0 Then
        strErrorMessage = Replace(Err.Description, vbCrLf, " ")
        strErrorMessage = "Error " & Err.Number & ": " & strErrorMessage

        '* write log data
        Call WriteOutput ("RelocateFile failed: " & strErrorMessage, intIndent + 1, "ERROR")

'        '* send email
'        Call SendEmail (strErrorToEmail, "", "", "VBSAutoDoc RelocateFile Error", "Copy '" & strSourceFilePath & "' failed: " & strErrorMessage, intIndent + 1)

        '* exit
        Call ExitMe (-6)
    End If
    On Error Goto 0

    '* attempt to delete file if requested
    If booDeleteFile = True then
        On Error Resume Next 
        Call objFSO.DeleteFile (strSourceFilePath, True)

        '* if error, report and exit
        If Err.Number <> 0 Then
            strErrorMessage = Replace(Err.Description, vbCrLf, " ")
            strErrorMessage = "Error " & Err.Number & ": " & strErrorMessage

            '* write log data
            Call WriteOutput ("RelocateFile failed: " & strErrorMessage, intIndent + 1, "ERROR")

'            '* send email
'            Call SendEmail (strErrorToEmail, "", "", "VBSAutoDoc RelocateFile Error", "Delete '" & strSourceFilePath & "' failed: " & strErrorMessage, intIndent + 1)

            '* exit
            Call ExitMe (-7)
        End If
        On Error Goto 0

    End If

    '* write log data and end sub
    Call WriteOutput ("End RelocateFile", intIndent, "INFO")

End Sub

RemoveEmptySubFolders

This subroutine recursively deletes folders that have no content.

Sub RemoveEmptySubFolders (ByVal strFolder, ByVal intIndent)
'*********************************************************************************************
'* Sub RemoveEmptySubFolders (ByVal strFolder, ByVal intIndent))
'* Purpose: Recursively deletes folders that have no content
'* intIndent: number of indents to use (for recursion logging)
'* strFolder: path of folder whose subfolders are to be removed if they are empty
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim intLoop

    '* write log data
    Call WriteOutput ("Start RemoveEmptySubFolders ('" & strFolder & "', " & intIndent & ")", intIndent, "INFO")

    '* Set initial folder in array
    ReDim Preserve arrFolders(0)
    arrFolders(0) = strFolder
    intArrayFoldersSize = 1

    '* Check for remove folder, exit if not found
    If objFSO.FolderExists(strFolder) = True then
        '* Get array of empty folders
        Call GetEmptySubFolders (objFSO.GetFolder(strFolder), intIndent + 1)

        '* if array contains more than initial entry, delete all but the initial entry
        If Ubound(arrFolders) <> 0 Then
            For intLoop = Ubound(arrFolders) to 1 Step -1  
                Call objFSO.DeleteFolder (arrFolders(intLoop), True)
                Call WriteOutput ("Deleted '" & arrFolders(intLoop) & "'", intIndent + 1, "DEBUG")
                Call Pause("1")
            Next
        Else
            Call WriteOutput ("No empty subfolders to remove", intIndent + 1, "DEBUG")
        End If
    Else
        strErrorMessage = "RemoveEmptySubFolders failed: Can't find folder to remove: " & strPath

        '* write log data
        Call WriteOutput (strErrorMessage, intIndent + 1, "ERROR")

'        '* send email
'        Call SendEmail (strErrorToEmail, "", "", "VBSAutoDoc RemoveEmptySubFolders Error", strErrorMessage, intIndent + 1)

        '* cleanup and exit
        Call ExitMe (-8)     
    End If
    On Error Goto 0

    '* write log data and end sub
    Call WriteOutput ("End RemoveEmptySubFolders", intIndent, "INFO")

    Call Pause("1")

End Sub

SendEmail

This subroutine sends an email message.

Sub SendEmail (ByVal strToEmail, ByVal strCCEmail, ByVal strBCCEmail, ByVal strSubject, ByVal strMessage, ByVal intIndent)
'*********************************************************************************************
'* Sub SendEmail (ByVal strToEmail, ByVal strFromEmail, ByVal strCCEmail, ByVal strBCCEmail, ByVal strSubject, ByVal strMessage, ByVal intIndent)
'* Purpose: send an email message
'* strToEmail: comma delimited list of email addresses for the To
'* strCCEmail: comma delimited list of email addresses for the CC
'* strBCCEmail: comma delimited list of email addresses for the BCC
'* strSubject: Subject
'* strMessage: Body
'* intIndent: number of indents to use (for recursion logging)
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim objEmail
    Dim strLogMessage, strErrorMessage

    '* create base scripting objects
    Set objEmail = CreateObject("CDO.Message")

    '* create message data for logging
    strLogMessage = Replace(strMessage, vbCrLf, vbCrLf & "                                    ")

    '* write log data
    WriteOutput "Start SendEmail (" & strToEmail & ", " & strFromEmail & ", " & strCCEmail & ", " & strBCCEmail & ", '" & strSubject & "', " & intIndent & ")", intIndent, "INFO"
    WriteOutput "strMessage: " & strLogMessage, intIndent + 1, "DEBUG"

    '* set CDO parameters
    objEmail.To = strToEmail
    objEmail.CC = strCCEmail
    objEmail.BCC = strBCCEmail
    objEmail.Subject = strSubject 
    objEmail.Textbody = strMessage
    objEmail.From = "admin@mail.server.com"
    objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.server.com" 
    objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
    objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "user@mail.server.com"
    objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
    objEmail.Configuration.Fields.Update

    '* attempt to send message
    On Error Resume Next 
    objEmail.Send

    '* if error, report and exit
    If Err.Number <> 0 Then
        strErrorMessage = Replace(Err.Description, vbCrLf, " ")
        strErrorMessage = "Error " & Err.Number & ": " & strErrorMessage

        '* write log data
        WriteOutput "Email send failed: " & strErrorMessage, intIndent + 1, "ERROR"

        '* exit
        Call ExitMe (-1)
    End If    
    On Error Goto 0 

    '* Set objects to Nothing
    Set objEmail = Nothing

    '* write log data and end sub
    WriteOutput "End SendEmail", intIndent, "INFO"

End Sub

SetRegistry

This subroutine sets a registry value.

Sub SetRegistry (ByVal strKey, ByVal strValue, ByVal strType, ByVal intIndent)
'*********************************************************************************************
'* Sub SetRegistry (ByVal strKey, ByVal strValue, ByVal strType, ByVal intIndent)
'* Purpose: sets a registry value
'* strKey: registry key whose value is to be set
'* strValue: registry value to be set
'* strType: value type (if there is no value type, ie. text, then set this to "NONE")
'* intIndent: How many tabs to indent the log output
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim objShell
    Dim strErrorMessage

    '* write log data
    WriteOutput "Start SetRegistry (" & strKey & ", '" & strValue & "', " & intIndent & ")", intIndent, "INFO"

    '* attempt to set registry key values
    On Error Resume Next

    If strType = "NONE" Then
        objWshShell.RegWrite strKey, strValue
    Else
        objWshShell.RegWrite strKey, strValue, strType
    End if

    '* if error, report and exit
    If Err.Number <> 0 Then
        strErrorMessage = Replace(Err.Description, vbCrLf, " ")
        strErrorMessage = "Error " & Err.Number & ": " & strErrorMessage

        '* write log data
        WriteOutput "SetRegistry failed: " & strErrorMessage, intIndent + 1, "ERROR"

        '* exit
        Call ExitMe (-28)
    End If    
    On Error Goto 0  

    '* Set objects to Nothing
    Set objShell = Nothing

    '* write log data and end sub
    WriteOutput "Registy Value written: " & strValue, intIndent + 1, "DEBUG"
    WriteOutput "End SetRegistry", intIndent, "INFO"

End Sub

WriteIni

This subroutine writes a value to an INI file. Use with its partner ReadIni.

Sub WriteIni (ByVal myFilePath, ByVal mySection, ByVal myKey, ByVal myValue, ByVal intIndent)
'*********************************************************************************************
'* Sub WriteIni (ByVal myFilePath, ByVal mySection, ByVal myKey, ByVal myValue, ByVal intIndent)
'* Purpose: This subroutine writes a value to an INI file
'* myFilePath: the (path and) file name of the INI file
'* mySection: the section in the INI file to be searched
'* myKey: the key whose value is to be written
'* myValue: the value to be written (myKey will be deleted if myValue is <DELETE_THIS_VALUE>)
'* intIndent: number of indents to use (for recursion logging)
'* Returns: the [string] value for the specified key in the specified section
'* CAVEAT: WriteIni function needs ReadIni function to run
'* Written by Keith Lacelle
'* Modified by Denis St-Pierre, Johan Pol and Rob van der Woude
'* Modified by Michael D. Shook
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

    Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
    Dim intEqualPos
    Dim objFSO, objNewIni, objOrgIni, wshShell
    Dim strFilePath, strFolderPath, strKey, strLeftString
    Dim strLine, strSection, strTempDir, strTempFile, strValue

    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )
    strValue    = Trim( myValue )

    '* write log data
    WriteOutput "Start WriteIni ('" & myFilePath & "', " & mySection & ", " & myKey & ", '" & myValue & "', " & intIndent & ")", intIndent, "INFO"

    '* create base scripting objects

    Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
    Set wshShell = CreateObject( "WScript.Shell" )

    'strTempDir  = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
    'strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )
    strTempFile = strFilePath & ".temp"    
    WriteOutput "strTempFile: " & strTempFile, intIndent + 1, "DEBUG"

    Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True )
    Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )

    blnInSection     = False
    blnSectionExists = False
    '* Check if the specified key already exists
    blnKeyExists     = ( ReadIni( strFilePath, strSection, strKey, False, 1) <> "" )
    blnWritten       = False

    '* Check if path to INI file exists, report error and exit if not
    strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
    If Not objFSO.FolderExists ( strFolderPath ) Then
        strErrorMessage = "WriteIni failed: Can't find ini file: " & myFilePath

        '* write log data
        WriteOutput strErrorMessage & myKey, intIndent + 1, "ERROR"

        '* cleanup and exit
        Set objOrgIni = Nothing
        Set objNewIni = Nothing
        Set objFSO    = Nothing
        Call ExitMe (-18)
    End If

    '* Check if temp INI file exists, report error and exit if not
    'strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
    'If Not objFSO.FolderExists ( strFolderPath ) Then
    If Not objFSO.FileExists ( strTempFile ) Then
        strErrorMessage = "WriteIni failed: Can't find temp ini file: " & strTempFile

        '* write log data
        WriteOutput strErrorMessage & myKey, intIndent + 1, "ERROR"

        '* cleanup and exit
        Set objOrgIni = Nothing
        Set objNewIni = Nothing
        Set objFSO    = Nothing
        Call ExitMe (-27)
    End If

    '* process each line of ini file
    While objOrgIni.AtEndOfStream = False
        strLine = Trim( objOrgIni.ReadLine )
        If blnWritten = False Then
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                blnSectionExists = True
                blnInSection = True
            ElseIf InStr( strLine, "[" ) = 1 Then
                blnInSection = False
            End If
        End If

        '* if line is a section name, look for key
        If blnInSection Then
            '* if key exists, find value position
            If blnKeyExists Then
                intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
                '* if value position found, parse it
                If intEqualPos > 0 Then
                    strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                    '* If this is where we are supposed to be write the key
                    If LCase( strLeftString ) = LCase( strKey ) Then
                        '* Only write the key if the value isn't empty
                        '* Modification by Johan Pol
                        If strValue <> "<DELETE_THIS_VALUE>" Then
                            objNewIni.WriteLine strKey & "=" & strValue
                        End If
                        blnWritten   = True
                        blnInSection = False
                    End If
                End If
                If Not blnWritten Then
                    objNewIni.WriteLine strLine
                End If
            '* if key doesn't exist, try to create it
            Else
                objNewIni.WriteLine strLine
                '* Only write the key if the value isn't empty
                '* Modification by Johan Pol
                If strValue <> "<DELETE_THIS_VALUE>" Then
                    objNewIni.WriteLine strKey & "=" & strValue
                End If
                blnWritten   = True
                blnInSection = False
            End If
        Else
            objNewIni.WriteLine strLine
        End If
    Wend

    '* if section doesn't exist, create it
    If blnSectionExists = False Then 
        objNewIni.WriteLine
        objNewIni.WriteLine "[" & strSection & "]"
        '* Only write the key if the value isn't empty
        '* Modification by Johan Pol
        If strValue <> "<DELETE_THIS_VALUE>" Then
            objNewIni.WriteLine strKey & "=" & strValue
        End If
    End If

    objOrgIni.Close
    objNewIni.Close

    '* Pause for 5 seconds    
    WriteOutput "Pausing for 5 seconds to allow file write to complete...", intIndent + 1, "DEBUG"
    Pause(5)

    '* Delete old INI file
    objFSO.DeleteFile strFilePath, True

    '* Rename new INI file
    objFSO.MoveFile strTempFile, strFilePath

    '* Set objects to Nothing
    Set objOrgIni = Nothing
    Set objNewIni = Nothing
    Set objFSO    = Nothing
    Set wshShell  = Nothing

    '* write log data and end sub
    WriteOutput "Value Written: " & myValue, intIndent + 1, "DEBUG"
    WriteOutput "End WriteIni", intIndent, "INFO"

End Sub

WriteOutput

This subroutine writes output to the screen and log file.

Sub WriteOutput (ByVal strOutput, ByVal intTabs, ByVal strPriority)
'*********************************************************************************************
'* Sub WriteOutput (byVal strOutput, ByVal intTabs, ByVal strPriority)
'* Purpose: Write output to the screen and log file
'* strOutput: String to write
'* intTabs: Number of tabs (as spaces) to indent the line
'* strPriority: The priority of the output to be written.
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim strIndents

    '* if intTabs is not negative, write the output
    If CInt(intTabs) >= 0 Then

        '* create indent string
        strIndents = Space(intTabs * 3)

        '* Output to log file
        If Not IsEmpty(objLogFile) Then
            If Not objLogFile Is Nothing Then 
                Call objLogFile.WriteLine (CreateTimeStamp() & "|" & Left(UCase(strPriority) & String(5," "), 5) & "|" & strIndents & strOutput)
            End If  
        End If    

        '* Output to screen
        Call WScript.Echo (CreateTimeStamp() & "|" & Left(UCase(strPriority) & String(5," "), 5) & "|" & strIndents & strOutput)

    End If

End Sub