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|