Skip to content

VBSAutoDoc

This script is a complete application that can be used not only for its intended purpose, but also to show how all the other Visual Basic Scripts on the site can come together and be used.

When run, it will generate the README file, as well as a log file for troubleshooting purposes.

Purpose

Will take any .vbs file in the folder that this script is also in and create documentation based on comments that begin with '*

Script

Option Explicit

'*********************************************************************************************
'*  Name:       VBSAutoDoc
'*  Version:    7.0.0.42
'*  Created:    04/12/2019
'*  Author:     Michael D. Shook
'*  Purpose:    Will take any .vbs file in the folder that this script is also in and create documentation based on comments that begin with '*
'*  Arguments:  Versionize (optional)
'*                When equal to "True", and the script being documented contains a strVersion variable, that data will be inserted into the documentation file's name
'*                When not sent or not equal to "True", the documentation file's name will not include a version number
'*  Example:    VBSAutoDoc.exe True
'*  History:    Michael D. Shook, 04/12/2019
'*                Version 7.0.0.42 - Created this version of the script from several sources in the internet over several years, none of which had a version number
'*                This is the first versioned instance of this script
'*  Exit Codes: >= 0 = OK and the value will be the count of files processed
'*                -1 = Could not open .vbs file for reading in BuildDocFiles
'*                -2 = Could not open documentation file for writing in BuildDocFiles
'*                -3 = Could not write line in documentation file in BuildDocFiles
'*                -4 = Could not find folder in FolderPurge
'*                -5 = Could not delete file in FolderPurge
'*                -6 = Could not copy file in RelocateFile
'*                -7 = Could not delete file in RelocateFile
'*                -8 = Could not find folder to be deleted in RemoveEmptySubFolders
'********************************************************************************************* 

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

    Dim objWshShell, objFSO, objScriptFile, objScriptFolder, objLogFile
    Dim strVersion, strPath, strScriptFolder, strShortScriptName, strLogFolder, strErrorMessage, strErrorToEmail
    Dim intExitCode, intArrayFoldersSize
    Dim arrFolders()
    Dim booArg1

    strVersion = "7.0.0.42"
    intExitCode = 0
    strErrorToEmail = "Mike@OmegaTower.com"
'    strErrorToEmail = "admin@server.com"

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

    '* Get argument 1
    If Wscript.Arguments.Count <> 0 Then 
        If UCase(WScript.Arguments.Item(0)) = "TRUE" Then 
            booArg1 = True
        Else
            booArg1 = False
        End If
    Else
        booArg1 = False
    End If

    '* get folder where script is running
    strPath = Wscript.ScriptFullName
    Set objScriptFile = objFSO.GetFile(strPath)
    strScriptFolder = objFSO.GetParentFolderName(objScriptFile)
    Set objScriptFolder = objFSO.GetFolder(strScriptFolder)

    '* get the script name minus the extension
    strShortScriptName = Mid(Wscript.ScriptName, 1, InStrRev(Wscript.ScriptName, ".") -1)

    '* Call InitializeLogFile
    InitializeLogFile

    '* Write initial lines to outputs
    Call WriteOutput ("************** Begin " & strShortScriptName & "-" & strVersion & " ************", 0, "INFO")
    Call WriteOutput ("Versionize: " & booArg1, 0, "INFO")

    '* Purge log folder and any subfolders of old files
    Call FolderPurge(strLogFolder, DateAdd("d", -365, Now()), strLogFolder, "", True, 0)

    '* Remove empty subfolders in the log folder
    Call RemoveEmptySubFolders(strLogFolder, 0)

    '* Build the documentation files
    Call BuildDocFiles (booArg1, 0)

    '* Call ExitMe
    ExitMe intExitCode
'*
Sub BuildDocFiles (ByVal booVersionize, ByVal intIndent)
'*********************************************************************************************
'* Sub BuildDocFiles (ByVal booVersionize, ByVal intIndent)
'* Purpose: process each .vbs file in the folder and create the documentation file
'* booVersionize: If true then the version number found in the vbs script will be used to update the documentation file name
'* intIndent: number of indents to use (for recursion logging)
'*********************************************************************************************

    '* Initialize constants, variables and objects
    Dim objScriptFileRead, objDocumentationFile
    Dim strScriptFileNameBase, strCurrentLine, strFileVersion, strDocumentationFileName, strDocumentationVersionedFileName
    Dim intFileCount, intIsComment, intIsVersion
    Dim booVersionFound

    intFileCount = 0
    booVersionFound = False

    '* write output data
    Call WriteOutput ("Start BuildDocFiles (" & booVersionize & ", " & intIndent & ")", intIndent, "INFO")

    '* process each file in the folder
    For Each objScriptFile In objScriptFolder.Files
        '* if it's a .VBS and not this .vbs, process file
        If (UCase(objFSO.GetExtensionName(objScriptFile.Name)) = "VBS") Then

            '* write output data
            Call WriteOutput ("Starting '" & objScriptFile.Name & "'", intIndent + 1, "DEBUG")

            '* read the .vbs file
            On Error Resume Next 
            Set objScriptFileRead = objFSO.OpenTextFile(objScriptFile.Path, ForReading)

            '* 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 ("BuildDocFiles failed: " & strErrorMessage, intIndent + 1, "ERROR")

'                '* send email
'                Call SendEmail (strErrorToEmail, "", "", "VBSAutoDoc BuildDocFiles Error", "Read '" & objScriptFile.Path & "' failed: " & strErrorMessage, intIndent + 1)

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

            '* get the .vbs file base name
            strScriptFileNameBase = Replace(objScriptFile.Name, ".vbs", "")
            strDocumentationFileName = strScriptFolder & "\README - " & strScriptFileNameBase & ".txt"

            '* create and open the documentation file
            On Error Resume Next 
            Set objDocumentationFile = objFSO.OpenTextFile(strDocumentationFileName, ForWriting, 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 ("BuildDocFiles failed: " & strErrorMessage, intIndent + 1, "ERROR")

'                '* send email
'                Call SendEmail (strErrorToEmail, "", "", "VBSAutoDoc BuildDocFiles Error", "Open '" & strDocumentationFileName & "' failed: " & strErrorMessage, intIndent + 1)

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

            '* inspect each line the the .vbs file to see if it's a documentation comment
            Do While objScriptFileRead.AtEndOfStream <> True
                '* current line
                strCurrentLine = objScriptFileRead.ReadLine

                '* determine if it's a documentation comment
                intIsComment = InStr(1,LTrim(Replace(strCurrentLine, vbTab, "")),"'*")

                '* if the line is a documentaion comment, then write it to the documentation file
                If intIsComment = 1 Then
                    On Error Resume Next
                    Call objDocumentationFile.Write (strCurrentLine & vbCrLf)

                    '* 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 ("BuildDocFiles failed: " & strErrorMessage, intIndent + 1, "ERROR")

'                        '* send email
'                        Call SendEmail (strErrorToEmail, "", "", "VBSAutoDoc BuildDocFiles Error", "Write '" & strDocumentationFileName & "' failed: " & strErrorMessage, intIndent + 1)

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

                '* determine if it's a strVersion line
                intIsVersion = Instr(1,LTrim(Replace(strCurrentLine, vbTab, "")),"strVersion")

                '* if the line is a strVersion line, then get the version value
                If intIsVersion = 1 Then
                    booVersionFound = True
                    strFileVersion = Replace(Replace(Replace(Mid(strCurrentLine, InStrRev(strCurrentLine, "=") -1, Len(strCurrentLine)), "=", ""), " ", ""), Chr(34), "")
                    strDocumentationVersionedFileName = strScriptFolder & "\README - " & strScriptFileNameBase & "_" & strVersion & ".txt"

                    '* write log data
                    Call WriteOutput ("File version found: " & strFileVersion, intIndent + 1, "TRACE")
                End If
            Loop

            '* close the documentation file
            Call objDocumentationFile.Close ()

            '* write output data
            Call WriteOutput ("Created '" & strDocumentationFileName & "'", intIndent + 1, "TRACE")

            '* if argument Versionize = True then rename the documentation file
            If booVersionFound = True And booVersionize = True Then
                Call RelocateFile (strDocumentationFileName, strDocumentationVersionedFileName, True, intIndent + 1)
            End If

            '* increment the file counter
            intFileCount = intFileCount + 1

            '* write output data
            Call WriteOutput ("Finished '" & objScriptFile.Name & "'", intIndent + 1, "DEBUG")

        End If 

    Next

    '* Set Exit Code to total files processed
    intExitCode = intFileCount

    '* Set objects to Nothing
    Set objScriptFileRead = Nothing
    Set objDocumentationFile = Nothing

    '* write output data
    Call WriteOutput ("Built " & intFileCount & " documentation files", intIndent + 1, "TRACE")
    Call WriteOutput ("End BuildDocFiles", intIndent, "INFO")

End Sub
'*
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
'*
Sub WriteOutput (ByVal strOutput, ByVal intTabs, ByVal strPriority)
'*********************************************************************************************
'* Sub WriteOutput (byVal strOutput, ByVal intTabs, ByVal strPriority)
'* Purpose: Write output to 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 
'*
Function CreateTimeStamp ()
'*********************************************************************************************
'* Function CreateTimeStamp ()
'* Purpose: return current timestamp in a format suitable for log files
'********************************************************************************************* 
    '* create timestamp
    CreateTimeStamp = Year(Now) & "-" & Right("0" & Month(Now),2)  & "-" & Right("0" & Day(Now),2)  & " " & Right("0" & Hour(Now),2) & ":" & Right("0" & Minute(Now),2) & ":" & Right("0" & Second(Now),2) 

End Function
'*
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
'*
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
'*
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
'*
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
'*
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
'*
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

Results

'*********************************************************************************************
'*  Name:       VBSAutoDoc
'*  Version:    7.0.0.42
'*  Created:    04/12/2019
'*  Author:     Michael D. Shook
'*  Purpose:    Will take any .vbs file in the folder that this script is also in and create documentation based on comments that begin with '*
'*  Arguments:  Versionize (optional)
'*                When equal to "True", and the script being documented contains a strVersion variable, that data will be inserted into the documentation file's name
'*                When not sent or not equal to "True", the documentation file's name will not include a version number
'*  Example:    VBSAutoDoc.exe True
'*  History:    Michael D. Shook, 04/12/2019
'*                Version 7.0.0.42 - Created this version of the script from several sources in the internet over several years, none of which had a version number
'*                This is the first versioned instance of this script
'*  Exit Codes: >= 0 = OK and the value will be the count of files processed
'*                -1 = Could not open .vbs file for reading in BuildDocFiles
'*                -2 = Could not open documentation file for writing in BuildDocFiles
'*                -3 = Could not write line in documentation file in BuildDocFiles
'*                -4 = Could not find folder in FolderPurge
'*                -5 = Could not delete file in FolderPurge
'*                -6 = Could not copy file in RelocateFile
'*                -7 = Could not delete file in RelocateFile
'*                -8 = Could not find folder to be deleted in RemoveEmptySubFolders
'********************************************************************************************* 
    '* Initialize constants, variables and objects
    '* Get argument 1
    '* get folder where script is running
    '* get the script name minus the extension
    '* Call InitializeLogFile
    '* Write initial lines to outputs
    '* Purge log folder and any subfolders of old files
    '* Remove empty subfolders in the log folder
    '* Build the documentation files
    '* Call ExitMe
'*
'*********************************************************************************************
'* Sub BuildDocFiles (ByVal booVersionize, ByVal intIndent)
'* Purpose: process each .vbs file in the folder and create the documentation file
'* booVersionize: If true then the version number found in the vbs script will be used to update the documentation file name
'* intIndent: number of indents to use (for recursion logging)
'*********************************************************************************************
    '* Initialize constants, variables and objects
    '* write output data
    '* process each file in the folder
        '* if it's a .VBS and not this .vbs, process file
            '* write output data
            '* read the .vbs file
            '* if error, report and exit
                '* write log data
                '* exit
            '* get the .vbs file base name
            '* create and open the documentation file
            '* if error, report and exit
                '* write log data
                '* exit
            '* inspect each line the the .vbs file to see if it's a documentation comment
                '* current line
                '* determine if it's a documentation comment
                '* if the line is a documentaion comment, then write it to the documentation file
                    '* if error, report and exit
                        '* write log data
                        '* exit
                '* determine if it's a strVersion line
                '* if the line is a strVersion line, then get the version value
                    '* write log data
            '* close the documentation file
            '* write output data
            '* if argument Versionize = True then rename the documentation file
            '* increment the file counter
            '* write output data
    '* Set Exit Code to total files processed
    '* Set objects to Nothing
    '* write output data
'*
'*********************************************************************************************
'* Sub ExitMe (ByVal intExitCode)
'* Purpose: sets objects to nothing, writes final log entry, exits
'*********************************************************************************************
    '* Pause for 5 seconds to display
    '* Set objects to Nothing
    '* Exit script
'*
'*********************************************************************************************
'* Sub WriteOutput (byVal strOutput, ByVal intTabs, ByVal strPriority)
'* Purpose: Write output to 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
    '* if intTabs is not negative, write the output
        '* create indent string
        '* Output to log file
        '* Output to screen
'*
'*********************************************************************************************
'* Function CreateTimeStamp ()
'* Purpose: return current timestamp in a format suitable for log files
'********************************************************************************************* 
    '* create timestamp
'*
'*********************************************************************************************
'* 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
    '* Send pings to simulate a pause
'*
'*********************************************************************************************
'* Sub InitializeLogFile ()
'* Purpose: Initialize current log file and rename previous day's log file with date stamp
'*********************************************************************************************
    '* Initialize constants, variables and objects
    '* build filename timestamp
    '* Create file system objects, log folder if it doesn't exist
    '* check if log file is from today, if it exists rename it with it's last mod date
        '* Rename previous days log file to new date named log file
    '* open log file
'*
'*********************************************************************************************
'* 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
    '* write log data
    '* Check for purge folder, exit if not found
        '* write log data
        '* cleanup and exit
    '* look in the current folder for files to delete
        '* get current file extension
        '* add delimiter to file extension
        '* if we got an error, just skip this entry
        '* check to see if the date is old and the extension is allowed
            '* attempt to delete the file
            '* if error, report and exit
                '* write log data
                '* exit
    '* Output results of current folder
    '* recurse the FolderPurge sub with the subdir paths
    '* Set objects to Nothing
    '* write log data and end sub
'*
'*********************************************************************************************
'* 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
    '* write log data
    '* attempt to copy file
    '* if error, report and exit
        '* write log data
        '* exit
    '* attempt to delete file if requested
        '* if error, report and exit
            '* write log data
            '* exit
    '* write log data and end sub
'*
'*********************************************************************************************
'* 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
    '* write log data
    '* Get collection of folders in current folder
            '* If the size of the folder is zero
            '* Call next layer of recursion
    '* Set objects to Nothing
    '* write log data and end sub
'*
'*********************************************************************************************
'* 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
    '* write log data
    '* Set initial folder in array
    '* Check for remove folder, exit if not found
        '* Get array of empty folders
        '* if array contains more than initial entry, delete all but the initial entry
        '* write log data
        '* cleanup and exit
    '* write log data and end sub

Log File

2019-04-16 06:46:42|INFO |************** Begin VBSAutoDoc-7.0.0.42 ************
2019-04-16 06:46:42|INFO |Versionize: False
2019-04-16 06:46:42|INFO |Start FolderPurge ('B:\Documents\Projects\VB Scripts\VBSAutoDoc\VBSAutoDoc-Logs\', 4/16/2018 6:46:42 AM, 'B:\Documents\Projects\VB Scripts\VBSAutoDoc\VBSAutoDoc-Logs\', , True, 0)
2019-04-16 06:46:42|TRACE|   Deleted 0 files from 'B:\Documents\Projects\VB Scripts\VBSAutoDoc\VBSAutoDoc-Logs\'
2019-04-16 06:46:43|INFO |End FolderPurge
2019-04-16 06:46:43|INFO |Start RemoveEmptySubFolders ('B:\Documents\Projects\VB Scripts\VBSAutoDoc\VBSAutoDoc-Logs\', 0)
2019-04-16 06:46:43|INFO |   Start GetEmptySubFolders ('VBSAutoDoc-Logs', 1)
2019-04-16 06:46:43|DEBUG|      'VBSAutoDoc-Logs' has no subfolders
2019-04-16 06:46:43|INFO |   End GetEmptySubFolders
2019-04-16 06:46:43|DEBUG|   No empty subfolders to remove
2019-04-16 06:46:43|INFO |End RemoveEmptySubFolders
2019-04-16 06:46:44|INFO |Start BuildDocFiles (False, 0)
2019-04-16 06:46:44|DEBUG|   Starting 'VBSAutoDoc.vbs'
2019-04-16 06:46:44|TRACE|   File version found: 7.0.0.42
2019-04-16 06:46:44|TRACE|   Created 'B:\Documents\Projects\VB Scripts\VBSAutoDoc\README - VBSAutoDoc.txt'
2019-04-16 06:46:44|DEBUG|   Finished 'VBSAutoDoc.vbs'
2019-04-16 06:46:44|TRACE|   Built 1 documentation files
2019-04-16 06:46:44|INFO |End BuildDocFiles
2019-04-16 06:46:44|INFO |Exit Code = 1
2019-04-16 06:46:44|INFO |************** Complete VBSAutoDoc-7.0.0.42 ************
2019-04-16 06:46:44|TRACE|
Back to top