I can’t leave well enough alone. Latest version of this thing… I played with Powershell a bit and if I keep doing changes like this, I’ll probably end up going with that language in the future, just not right this second.
- I added more safeguards to prevent sweeping mistakes. Can’t have too many.
- Added a test mode to have it just dump the output of what it would have done.
- Cleaned up the duplicate code I had by throwing in dynamic code blocks when able.
- Redid the logging entirely to make it much more functional.
** Use it on test folders prior to playing with it, same as before.
' *****************************
' *** MP3 Folder Processing ***
' *****************************
' =============================
' =============================
' User Defined Variables ------
strBaseDirectory = "\\server\share"
strTargetExtension = "mp3"
strAlbumArtName = "cover.jpg"
blnProcessUnsorted = True
strUnsortedDirectory = "\\server\share"
blnTestMode = False
intCorrectionAbortPercentage = 7.5
' Environment Variables -------
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Const ForAppending = 8
strScriptPath = WScript.ScriptFullName
Set objScript = objFSO.GetFile(strScriptPath)
strScriptName = objScript.Name
strLogName = Replace(strScriptName , ".vbs", ".log")
strLogPath = Replace(strScriptPath, strScriptName, strLogName)
Set objLogFile = objFSO.OpenTextFile(strLogPath,ForAppending,True)
' Dictionaries ---------------
arrDictionaries = Array( _
"Directories", _
"InvalidFiles", _
"DuplicateFiles", _
"SimilarArtistMultipleDirectory", _
"DirectoryCorrections", _
"UnmatchedDirectories", _
"DirectoryDeletions", _
"DirectoryDeletionFailures", _
"FileCount", _
"FileDeletions", _
"FileDeletionFailures", _
"SubDirectoryCount", _
"TargetFiles", _
"TempFileList", _
"TempWorkFlow")
For Each strDictionary In arrDictionaries
strTargetDictionary = "dic" & strDictionary
strExecCmd = "Set " & strTargetDictionary & " = CreateObject(""Scripting.Dictionary"")"
Execute strExecCmd
Select Case strDictionary
Case "Directories", "SimilarArtistMultipleDirectory"
strExecCmd = strTargetDictionary & ".CompareMode = VBTextCompare"
Execute strExecCmd
End Select
Next
' Primary Execution ---------
dtmTimeStart = Now()
subLog "Script execution begin. Test mode = " & blnTestMode
subLog "Creating catalog"
subCatalogDirectory strBaseDirectory
dtmCatalogComplete = Now()
subLog "Catalog creation complete"
intDirectoryCorrectionPercentage = Round(dicDirectoryCorrections.Count / dicDirectories.Count * 100, 2)
If intDirectoryCorrectionPercentage >= intCorrectionAbortPercentage Then
strMessage = "Error: Directory correction percentage threshold reached (" & intDirectoryCorrectionPercentage & "%). Terminating script as safeguard."
subLog strMessage
objLogFile.Close
MsgBox strMessage, 0, UCase(strTargetExtension) & " Processing"
WScript.Quit
Else
subLog "Directory correction percentage threshold within defined limits (" & intDirectoryCorrectionPercentage & "%). Continuing Script."
End If
For Each strDictionary In arrDictionaries
strTargetDictionary = "dic" & strDictionary
Execute "intTargetDictionaryCount = " & strTargetDictionary & ".Count"
If intTargetDictionaryCount >= 1 Then
subCloneDictionary strTargetDictionary, "dicTempWorkFlow"
subLog "Processing dictionary object " & fncQuote(strTargetDictionary) & ", Total Records = " & intTargetDictionaryCount
Select Case strDictionary
Case "DirectoryCorrections", "SimilarArtistMultipleDirectory", "UnmatchedDirectories"
strExecCmd = _
"If " & strDictionary & " <> ""UnmatchedDirectories"" Or blnProcessUnsorted Then" & vbCrLf & _
"blnActionRequired = True" & vbCrLf & _
"End If"
Execute strExecCmd
If blnActionRequired Then
For Each strKey In dicTempWorkFlow
strValue = dicTempWorkFlow.Item(strKey)
If strValue <> strBaseDirectory Then
If fncDirectoryExists(strValue) Then
subCatalogFiles(strKey)
For Each strSourceFilePath In dicTempFileList
strSourceFileName = dicTempFileList.Item(strSourceFilePath)
strDestFilePath = strValue & "\" & strSourceFileName
subEvaluateFileCopyMove strSourceFilePath, strDestFilePath
Next
dicTempFileList.RemoveAll
subDirectoryDelete(strKey)
Else
subDirectoryMove strKey, strValue
End If
End If
Next
End If
Case "DirectoryDeletionFailures", "FileDeletionFailures"
strFSOType = ""
If InStr(strDictionary, "Directory") Then
strFSOType = "Directory"
ElseIf InStr(strDictionary, "File") Then
strFSOType = "File"
End If
If strFSOType <> "" Then
For Each strKey in dicTempWorkFlow
strValue = dicTempWorkFlow.Item(strKey)
If InStr(strValue, "Path Not Empty") Or InStr(strValue, "File Not Found") Then
strExecCmd = _
"If fnc" & strFSOType & "Exists(" & strKey & ") Then" & vbCrLf & _
"blnObjectExists = True" & vbCrLf & _
"Else" & vbCrLf & _
"blnObjectExists = False" & vbCrLf & _
"End If"
Execute strExecCmd
If blnObjectExists Then
subLog "Deletion failure against " & fncQuote(strKey)
Else
subLog "Validated successful removal of " & fncQuote(strKey)
End If
End If
Next
End If
Case "DirectoryDeletions"
For Each strKey In dicTempWorkFlow
strValue = dicTempWorkFlow.Item(strKey)
If dicFileCount.Exists(strKey) And dicSubDirectoryCount.Exists(strKey) Then
intFileCount = dicFileCount.Item(strKey)
intSubDirectoryCount = dicSubDirectoryCount.Item(strKey)
If intFileCount = 0 And intSubDirectoryCount = 0 Then
subDirectoryDelete(strKey)
End If
End If
Next
Case "DuplicateFiles"
For Each strKey In dicTempWorkFlow
strValue = dicTempWorkFlow.Item(strKey)
If dicTargetFiles.Exists(strValue) Then
subFileDelete(strKey)
Else
subEvaluateFileCopyMove strKey, strValue
End If
Next
Case "InvalidFiles"
For Each strKey In dicTempWorkFlow
strValue = dicTempWorkFlow.Item(strKey)
strActionRequired = fncEvaluateExtension(strKey)
Select Case strActionRequired
Case "CORRECT"
strInvalidFileExtension = objFSO.GetExtensionName(strKey)
strCorrectFileName = Left(strValue, Len(strValue) - Len(strInvalidFileExtension)) & strTargetExtension
strCorrectFilePath = Replace(strKey, strValue, strCorrectFileName)
subEvaluateFileCopyMove strKey, strCorrectFilePath
Case "DELETE"
subFileDelete(strKey)
Case "EXCLUDE"
subLog "File extension exclusion: " & fncQuote(strKey)
End Select
Next
End Select
End If
dicTempWorkFlow.RemoveAll
Next
dtmTimeEnd = Now()
intCatalogExecutionTime = DateDiff("n", dtmTimeStart, dtmCatalogComplete)
intCorrectiveActionExecutionTime = DateDiff("n", dtmCatalogComplete, dtmTimeEnd)
intScriptExecutionTime = DateDiff("n", dtmTimeStart, dtmTimeEnd)
subLog "Script Execution Complete. Total Run Time = " & intScriptExecutionTime & " minutes."
objLogFile.Close
strCompletionMessage = UCase(strTargetExtension) & " processing complete. (Total = " & dicTargetFiles.Count & ")" & vbCrLf & vbCrLf & _
"Directory Corrections: " & dicDirectoryCorrections.Count & vbCrLf & _
"Directory Removals: " & dicDirectoryDeletions.Count & vbCrLf & _
"Similar Directories: " & dicSimilarArtistMultipleDirectory.Count & vbCrLf & _
"Unmatched Directories: " & dicUnMatchedDirectories.Count & vbCrLf & _
"Duplicate " & UCase(strTargetExtension) & " Removals: " & dicDuplicateFiles.Count & vbCrLf & _
"Invalid File Extensions: " & dicInvalidFiles.Count & vbCrLf & vbCrLf & _
"Run Time: " & intScriptExecutionTime & " minutes (Catalog: " & intCatalogExecutionTime & " / Corrections: " & intCorrectiveActionExecutionTime & ")"
MsgBox strCompletionMessage, 0, UCase(strTargetExtension) & " Processing"
' Functions ---------------
Function fncConjunctionReplacement(strText)
If strText <> "" Then
strOutput = strText
arrUnwantedConjunctions = Array( _
" And ", _
" and ")
For Each strUnwantedConjunction In arrUnwantedConjunctions
strOutput = Replace(strOutput, strUnwantedConjunction, " & ")
Next
fncConjunctionReplacement = strOutput
Else
fncConjunctionReplacement = strText
End If
End Function
Function fncDirectoryExists(strDirectory)
If strDirectory <> "" Then
If objFSO.FolderExists(strDirectory) Then
fncDirectoryExists = True
Else
fncDirectoryExists = False
End If
Else
fncDirectoryExists = False
End If
End Function
Function fncEvaluateExtension(strFilePath)
If strFilePath <> "" Then
blnActionRequired = True
strInvalidFileExtension = objFSO.GetExtensionName(strFilePath)
arrInvalidFileExceptions = Array( _
"8svx", _
"aax", _
"act", _
"ai", _
"aif", _
"aifc", _
"aiff", _
"alac", _
"amr", _
"ape", _
"au", _
"awb", _
"dct", _
"dss", _
"dvf", _
"ea", _
"eps", _
"flac", _
"gif", _
"gsm", _
"iklax", _
"indd", _
"ivs", _
"jpeg", _
"jpg", _
"m4a", _
"m4b", _
"m4p", _
"m4u", _
"midi", _
"mmf", _
"mp3", _
"mpc", _
"msv", _
"nsf", _
"ogg", _
"ogg", _
"opus", _
"pdf", _
"png", _
"psd", _
"ra", _
"raw", _
"sln", _
"tif", _
"tiff", _
"tta", _
"vox", _
"wav", _
"wave", _
"webm", _
"wma", _
"wv")
For Each strInvalidFileException In arrInvalidFileExceptions
If strInvalidFileExtension = strInvalidFileException And Not Right(strInvalidFilePath, Len(strAlbumArtName)) = strAlbumArtName Then
blnActionRequired = False
Exit For
End If
Next
If Right(strInvalidFilePath, Len(strAlbumArtName)) = strAlbumArtName Then
fncEvaluateExtension = "DELETE"
Else
If blnActionRequired Then
fncEvaluateExtension = "CORRECT"
Else
fncEvaluateExtension = "EXCLUDE"
End If
End If
Else
fncEvaluateExtension = "INVALID"
End If
End Function
Function fncFileExists(strFile)
If strFile <> "" Then
If objFSO.FileExists(strFile) Then
fncFileExists = True
Else
fncFileExists = False
End If
Else
fncFileExists = False
End If
End Function
Function fncParseNameSplit(strDirectoryName)
If strDirectoryName <> "" Then
strOutput = Trim(strDirectoryName)
arrSplitEvals = Array( _
";", _
",", _
" - ", _
" Avec ", _
" avec ", _
" CD ", _
" cd ", _
" Der ", _
" der ", _
"Duet", _
"duet", _
" En ", _
" en ", _
"Feat", _
"feat", _
" (Ft", _
" (ft", _
" [Ft", _
" [ft", _
" Ft", _
" ft", _
" Med ", _
" med ", _
" Met ", _
" met ", _
" Meet ", _
" meet ", _
" Mit ", _
" mit ", _
"Original", _
"original", _
"Pheaturing", _
"pheaturing", _
" Read by ", _
" read by ", _
"Soundtrack", _
"soundtrack", _
" Und ", _
" und ", _
" Vs", _
" vs", _
" part ", _
" Part ", _
"Presents", _
"presents", _
"+", _
"&", _
" And ", _
" and ", _
"With", _
"with")
For Each strSplitEval In arrSplitEvals
If InStr(strDirectoryName, strSplitEval) Then
arrSplitDetails = Split(strDirectoryName, strSplitEval)
strPreSplitData = Trim(arrSplitDetails(0))
strPostSplitData = Trim(arrSplitDetails(UBound(arrSplitDetails)))
If strPreSplitData <> "" Then
If Not dicDirectories.Exists(strBaseDirectory & "\" & strPreSplitData) Then
Select Case strSplitEval
Case "+", "&", " And ", " and "
blnException = False
arrSplitExceptions = Array( _
"family", _
"his", _
"her", _
"jr", _
"the", _
"nine stories", _
"z")
For Each strSplitException In arrSplitExceptions
If Left(Trim(LCase(strPostSplitData)), Len(strSplitException)) = LCase(strSplitException) Then
blnException = True
Exit For
End If
Next
If fncSplitException(strPreSplitData, strPostSplitData) Then
blnException = True
End If
If blnException Then
For Each strOverrideEval In arrSplitEvals
If InStr(strPreSplitData, strOverrideEval) Then
If fncSplitException(strPreSplitData, strPostSplitData) Then
strOutput = Trim(strOutput)
Exit For
Else
strOutput = fncParseNameSplit(Trim(strPreSplitData))
End If
Else
strOutput = Trim(strOutput)
Exit For
End If
Next
Else
strOutput = fncParseNameSplit(Trim(strPreSplitData))
End If
Case ","
blnException = False
arrSplitExceptions = Array( _
"Earth, Wind & Fire")
For Each strSplitException In arrSplitExceptions
If Left(Trim(LCase(strDirectoryName)), Len(strSplitException)) = LCase(strSplitException) Then
blnException = True
Exit For
End If
Next
If Not blnException Then
If fncWordCount(strDirectoryName) <= 2 Then
strOutput = Trim(strDirectoryName)
Else
strOutput = fncParseNameSplit(Trim(strPreSplitData))
End If
Else
strOutput = Trim(strDirectoryName)
End If
Case Else
strOutput = fncParseNameSplit(Trim(strPreSplitData))
Exit For
End Select
Else
strOutput = Trim(strPreSplitData)
End If
Else
strOutput = Trim(strDirectoryName)
End If
End If
Next
fncParseNameSplit = Trim(fncConjunctionReplacement(strOutput))
End If
End Function
Function fncQuote(strText)
If strText <> "" And Not InStr(strText, Chr(34)) Then
fncQuote = Chr(34) & strText & Chr(34)
Else
fncQuote = strText
End If
End Function
Function fncRemovePlural(strText)
If strText <> "" And InStr(strText, "'s") Then
fncRemovePlural = Replace(strText, "'s", "")
Else
fncRemovePlural = strText
End If
End Function
Function fncReplaceDoubleChars(strInputText)
If strInputText <> "" Then
strOutputText = Trim(strInputText)
arrDoubleChars = Array( _
" ", _
".")
For Each strEvaluationChar In arrDoubleChars
strSingleChar = strEvaluationChar
strDoubleChar = strSingleChar & strSingleChar
Do While InStr(strOutputText, strDoubleChar)
strOutputText = Replace(strOutputText, strDoubleChar, strSingleChar)
Loop
Next
fncReplaceDoubleChars = Trim(strOutputText)
Else
fncReplaceDoubleChars = Trim(strInputText)
End If
End Function
Function fncRightCleanup(strText)
If strText <> "" Then
strOutput = Trim(strText)
arrInvalidChars = Array( _
".", _
"_", _
"(")
For Each strInvalidChar In arrInvalidChars
Do While Right(strOutput, Len(strInvalidChar)) = strInvalidChar
strOutput = Left(strOutput, Len(strOutput) - 1)
Loop
Next
fncRightCleanup = Trim(strOutput)
Else
fncRightCleanup = Trim(strText)
End If
End Function
Function fncSplitException(strPreSplitData, strPostSplitData)
If strPreSplitData <> "" And strPostSplitData <> "" Then
If fncWordCount(strPreSplitData) + fncWordCountPostSplitData <= 3 Then
fncSplitException = True
Else
If fncWordCount(strPreSplitData) = 1 And fncWordCount(strPostSplitData) >= 2 Then
fncSplitException = True
ElseIf fncWordCount(strPreSplitData) <= 2 And fncWordCount(strPostSplitData) = 1 Then
fncSplitException = True
ElseIf fncWordCount(strPreSplitData) = 2 And fncWordCount(strPostSplitData) = 2 Then
fncSplitException = False
Else
fncSplitException = False
End If
End If
Else
fncSplitException = False
End If
End Function
Function fncWordCount(strText)
If strText <> "" Then
arrTextDetails = Split(strText, " ")
fncWordCount = UBound(arrTextDetails) + 1
Else
fncWordCount = 1
End If
End Function
' Subroutines -------------
Sub subCatalogDirectory(strDirectory)
If strDirectory <> "" Then
If fncDirectoryExists(strDirectory) Then
Set objParentDirectory = objFSO.GetFolder(strDirectory)
For Each objSubDirectory In objParentDirectory.SubFolders
If Not dicDirectories.Exists(objSubDirectory.Path) Then
dicDirectories.Add objSubDirectory.Path, objSubDirectory.Name
dicSubDirectoryCount.Add objSubDirectory.Path, objSubDirectory.SubFolders.Count
dicFileCount.Add objSubDirectory.Path, objSubDirectory.Files.Count
If objSubDirectory.Files.Count >= 1 Then
For Each objFile In objSubDirectory.Files
If Right(objFile.Path, Len(strTargetExtension)) = strTargetExtension Then
If Not dicTargetFiles.Exists(objFile.Path) Then
dicTargetFiles.Add objFile.Path, objFile.Name
End If
Else
If Not dicInvalidFiles.Exists(objFile.Path) Then
dicInvalidFiles.Add objFile.Path, objFile.Name
End If
End If
subEvaluateFileDuplicate objFile.Path
Next
End If
subEvaluateDirectoryName objSubDirectory.Path, objSubDirectory.Name
SubCatalogDirectory objSubDirectory.Path
End If
Next
Set objParentDirectory = Nothing
End If
End If
End Sub
Sub subCatalogFiles(strDirectory)
If strDirectory <> "" Then
dicTempFileList.RemoveAll
If fncDirectoryExists(strDirectory) Then
Set objParentDirectory = objFSO.GetFolder(strDirectory)
Set colFiles = objParentDirectory.Files
For Each objFile In colFiles
If Not dicTempFileList.Exists(objFile.Path) Then
dicTempFileList.Add objFile.Path, objFile.Name
End If
Next
Set objParentDirectory = Nothing
End If
End If
End Sub
Sub subCloneDictionary(strSourceDic, strDestDic)
If strSourceDic <> "" And strDestDic <> "" Then
strExecCmd = _
strDestDic & ".RemoveAll" & vbCrLf & _
"arrDicKeys = " & strSourceDic & ".Keys" & vbCrLf & _
"arrDicValues = " & strSourceDic & ".Items"
Execute strExecCmd
For intCurrentRecord = LBound(arrDicKeys) To UBound(arrDicKeys)
strExecCmd = _
"If Not " & strDestDic & ".Exists(""" & arrDicKeys(intCurrentRecord) & """) Then" & vbCrLf & _
strDestDic & ".Add """ & arrDicKeys(intCurrentRecord) & """, """ & arrDicValues(intCurrentRecord) & """" & vbCrLf & _
"End If"
Execute strExecCmd
Next
End If
End Sub
Sub subDirectoryCreate(strDirectoryPath)
If strDirectoryPath <> "" Then
If Not fncDirectoryExists(strDirectoryPath) Then
subLog "Directory creation: " & fncQuote(strDirectoryPath)
If Not blnTestMode Then
objFSO.CreateFolder(strDirectoryPath)
End If
End If
End If
End Sub
Sub subDirectoryDelete(strDirectoryPath)
If strDirectoryPath <> "" And strDirectoryPath <> strBaseDirectory Then
If fncDirectoryExists(strDirectoryPath) Then
subCatalogFiles(strDirectoryPath)
If dicTempFileList.Count = 0 Then
If Not dicDirectoryDeletions.Exists(strDirectoryPath) Then
subLog "Directory deletion: " & fncQuote(strDirectoryPath)
If Not blnTestMode Then
Set objPhysicalFolderValidation = objFSO.GetFolder(strDirectoryPath)
intFSFileSystemCount = objPhysicalFolderValidation.Files.Count
intFSFolderSystemCount = objPhysicalFolderValidation.SubFolders.Count
If intFSFileSystemCount = 0 And intFSFolderSystemCount = 0 Then
On Error Resume Next
objFSO.DeleteFolder(strDirectoryPath)
If Err.Number <> 0 Then
dicDirectoryDeletionFailures.Add strDirectoryPath, Err.Description
Else
dicDirectoryDeletions.Add strDirectoryPath, Now()
End If
Err.Clear
On Error Goto 0
Else
subLog "Directory deletion failed final physical validation test. " & fncQuote(strDirectoryPath) & " not empty!"
End If
Set objPhysicalFolderValidation = Nothing
End If
End If
Else
If Not dicDirectoryDeletionFailures.Exists(strDirectoryPath) Then
dicDirectoryDeletionFailures.Add strDirectoryPath, "Path Not Empty"
End If
dicTempFileList.RemoveAll
End If
Else
If Not dicDirectoryDeletionFailures.Exists(strDirectoryPath) Then
dicDirectoryDeletionFailures.Add strDirectoryPath, "Path Not Found"
End If
End If
Else
If Not dicDirectoryDeletionFailures.Exists(strDirectoryPath) Then
dicDirectoryDeletionFailures.Add strDirectoryPath, "Invalid Data Passed To Function: " & fncQuote(strDirectoryPath)
End If
End If
End Sub
Sub subDirectoryMove(strSourcePath, strDestinationPath)
If strSourcePath <> "" And strDestinationPath <> "" And strDestinationPath <> strBaseDirectory Then
If fncDirectoryExists(strSourcePath) And Not fncDirectoryExists(strDestinationPath) Then
subLog "Directory move: " & fncQuote(strSourcePath) & " --> " & fncQuote(strDestinationPath)
If Not blnTestMode Then
objFSO.MoveFolder strSourcePath, strDestinationPath
End If
End If
End If
End Sub
Sub subEvaluateDirectoryMultiples(strDirectoryPath, strDirectoryName)
If strDirectoryPath <> "" And strDirectoryName <> "" Then
blnActionRequired = True
blnSimilarMatch = False
arrDuplicateExceptions = Array( _
"Dee Dee", _
"DJ", _
"New World", _
"South Park Mexican")
For Each strDuplicateException In arrDuplicateExceptions
If InStr(LCase(strDirectoryName), LCase(strDuplicateException)) Then
blnActionRequired = False
End If
Next
If blnActionRequired Then
intDirectoryWordCount = fncWordCount(strDirectoryName)
If intDirectoryWordCount >= 2 Then
arrDirectoryDetails = Split(strDirectoryName, " ")
intDirectoryDetailsUpper = UBound(arrDirectoryDetails)
strCurrentEvaluationPath = Trim(fncRemovePlural(strBaseDirectory & "\" & arrDirectoryDetails(0) & " " & arrDirectoryDetails(1)))
If dicDirectories.Exists(strCurrentEvaluationPath) And LCase(strDirectoryPath) <> LCase(strCurrentEvaluationPath) And LCase(strCurrentEvaluationPath) <> LCase(strBaseDirectory) Then
If Not dicSimilarArtistMultipleDirectory.Exists(strDirectoryPath) Then
dicSimilarArtistMultipleDirectory.Add strDirectoryPath, strCurrentEvaluationPath
blnSimilarMatch = True
End If
End If
If intDirectoryDetailsUpper > 2 And Not blnSimilarMatch And LCase(strDirectoryPath) <> LCase(strCurrentEvaluationPath) And LCase(strCurrentEvaluationPath) <> LCase(strBaseDirectory) Then
For intCurrentDirectoryEvaluation = 2 To intDirectoryDetailsUpper
strCurrentEvaluationPath = strCurrentEvaluationPath & " " & arrDirectoryDetails(intCurrentDirectoryEvaluation)
If dicDirectories.Exists(strCurrentEvaluationPath) And LCase(strDirectoryPath) <> LCase(strCurrentEvaluationPath) And LCase(strCurrentEvaluationPath) <> LCase(strBaseDirectory) Then
If Not dicSimilarArtistMultipleDirectory.Exists(strDirectoryPath) Then
dicSimilarArtistMultipleDirectory.Add strDirectoryPath, strCurrentEvaluationPath
Exit For
End If
End If
Next
End If
End If
End If
End If
End Sub
Sub subEvaluateDirectoryName(strDirectoryPath, strDirectoryName)
If strDirectoryPath <> "" And strDirectoryName <> "" Then
strOutputName = fncParseNameSplit(strDirectoryName)
strOutputName = fncReplaceDoubleChars(strOutputName)
strOutputName = fncRightCleanup(strOutputName)
strOutputName = Trim(strOutputName)
subEvaluateDirectoryMultiples strDirectoryPath, strDirectoryName
If Not dicSimilarArtistMultipleDirectory.Exists(strDirectoryPath) Then
If InStr(strOutputName, " ") Then
arrOutputNameDetails = Split(strOutputName, " ")
strFirstOutputName = arrOutputNameDetails(0)
Else
strFirstOutputName = strDirectoryName
End If
If strDirectoryName <> strOutputName Then
If Not dicDirectoryCorrections.Exists(strDirectoryPath) Then
dicDirectoryCorrections.Add strDirectoryPath, strBaseDirectory & "\" & strOutputName
End If
ElseIf Len(strDirectoryName) <= 2 And IsNumeric(strDirectoryName) Then
If Not dicUnMatchedDirectories.Exists(strDirectoryPath) Then
dicUnMatchedDirectories.Add strDirectoryPath, strUnsortedDirectory & "\" & strOutputName
End If
ElseIf Len(strFirstOutputName) = 3 And InStr(strFirstOutputName, ".") And IsNumeric(fncRightCleanup(strFirstOutputName)) Then
If Not dicUnMatchedDirectories.Exists(strDirectoryPath) Then
dicUnMatchedDirectories.Add strDirectoryPath, strUnsortedDirectory & "\" & strOutputName
End If
End If
End If
End If
End Sub
Sub subEvaluateFileCopyMove(strSourceFile, strDestFile)
If strSourceFile <> "" And strDestFile <> "" Then
If fncFileExists(strSourceFile) And fncFileExists(strDestFile) Then
subFileDelete strSourceFile
ElseIf fncFileExists(strSourceFile) And Not fncFileExists(strDestFile) Then
subFileMove strSourceFile, strDestFile
End If
End If
End Sub
Sub subFileDelete(strFilePath)
If strFilePath <> "" Then
subLog "File deletion: " & fncQuote(strFilePath)
If Not blnTestMode Then
If fncFileExists(strFilePath) Then
On Error Resume Next
objFSO.DeleteFile(strFilePath)
If Err.Number <> 0 Then
dicFileDeletionFailures.Add strFilePath, Err.Description
End If
Err.Clear
On Error Goto 0
Else
If Not dicFileDeletionFailures.Exists(strFilePath) Then
dicFileDeletionFailures.Add strFilePath, "File Not Found"
End If
End If
End If
Else
If Not dicFileDeletionFailures.Exists(strFilePath) Then
dicFileDeletionFailures.Add strFilePath, "Invalid Data Passed To Function: " & fncQuote(strFilePath)
End If
End If
End Sub
Sub subEvaluateFileDuplicate(strFilePath)
If strFilePath <> "" Then
blnDuplicate = False
If InStr(strFilePath, " - Copy." & strTargetExtension) Then
strCorrectFilePath = Replace(strFilePath, " - Copy." & strTargetExtension, "." & strTargetExtension)
blnDuplicate = True
Else
For intDupLevel = 1 to 99
arrAdditiveStrings = Array( _
".", _
"_", _
"(/)", _
"[/]")
For Each strAdditiveString In arrAdditiveStrings
Select Case strAdditiveString
Case ".", "_"
strEvaluationValue = strAdditiveString & intDupLevel & strAdditiveString & strTargetExtension
Case Else
arrAdditiveStringDetails = Split(strAdditiveString, "/")
strPreValue = arrAdditiveStringDetails(0)
strPostValue = arrAdditiveStringDetails(1)
strEvaluationValue = strPreValue & intDupLevel & strPostValue & "." & strTargetExtension
End Select
If InStr(strFilePath, strEvaluationValue) Then
strCorrectFilePath = Replace(strFilePath, strEvaluationValue, "." & strTargetExtension)
blnDuplicate = True
Exit For
End If
Next
If blnDuplicate Then
Exit For
End If
Next
End If
If blnDuplicate Then
If Not dicDuplicateFiles.Exists(strFilePath) Then
dicDuplicateFiles.Add strFilePath, strCorrectFilePath
End If
End If
End If
End Sub
Sub subFileMove(strSourceFilePath, strDestFilePath)
If strSourceFilePath <> "" And strDestFilePath <> "" And InStr(strDestFilePath, "\") Then
arrDestFileDetails = Split(strDestFilePath, "\")
strDestFileName = arrDestFileDetails(UBound(arrDestFileDetails))
strDestDirectory = Replace(strDestFilePath, strDestFileName, "")
subDirectoryCreate(strDestDirectory)
If fncFileExists(strSourceFilePath) And Not fncFileExists(strDestFilePath) Then
subLog "File move: " & fncQuote(strSourceFilePath) & " --> " & fncQuote(strDestFilePath)
If Not blnTestMode Then
objFSO.MoveFile strSourceFilePath, strDestFilePath
End If
End If
End If
End Sub
Sub subLog(strText)
If strText <> "" Then
On Error Resume Next
strText = Replace(strText, vbCrLf, " <BR> ")
objLogFile.WriteLine Now() & " - " & strText
If Err.Number <> 0 Then
objLogFile.WriteLine Now() & "- Error: Log write attempt resulted in " & fncQuote(Err.Description)
End If
Err.Clear
On Error Goto 0
End If
End Sub