Brute Force Crack an Encrypted Excel Workbook

This will ask how many threads you want to create so those will multiple core processors can leverage it to speed up the process. Just drag and drop an excel file onto the script. Since it's brute force, it's very slow and can only feasibly crack a password of up to 5 characters. However, you can concievable modify it to work across multiple computers.
 
There are some limitations of the script because of how I coded it.
- It will only test up to a 20 character password. Not really a limitation since you will never crack a password of that length anyways.
- It only tests characters from ascii character 32 to 126 even though you can use other characters in excel passwords.
- The script doesn't clean up the files that it creates.
- The other threads don't stop running after one of the threads has found the correct password.
 
There is one more limitation but that is due to Excel and not the script. When excel opens a file, it writes a temporary hidden file to the disk. So there is a bottleneck in terms of speed. If you create too many threads, the amount of writes to the disk will surpass the speed that the disk can write.
 

 Option Explicit
Dim strFilePath, nCores, objWMI, intJobID, objDateTime, i, objFSO, fileThread strFilePath = WScript.Arguments(0)
nCores = InputBox("Create how many threads?", "Number of Threads", 1)
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:Win32_Process")
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CreateTextFile "C:\ExcelCrackThread.vbs", True
Set fileThread = objFSO.OpenTextFile("C:\ExcelCrackThread.vbs", 8) fileThread.WriteLine "Option Explicit"
fileThread.WriteLine "Dim strCPWD, Found, strFilePath, objExcel, pw(20), nCores, sout, i"
fileThread.WriteLine "Set sout = createobject(""Scripting.FileSystemObject"").GetStandardStream(1)"
fileThread.WriteLine "strFilePath = WScript.Arguments(0)"
fileThread.WriteLine "nCores = WScript.Arguments(1)"
fileThread.WriteLine "strCPWD = Chr(31 + WScript.Arguments(2))"
fileThread.WriteLine "pw(0) = 31 + WScript.Arguments(2)"
fileThread.WriteLine "For i = 1 To 19"
fileThread.WriteLine "pw(i) = 0"
fileThread.WriteLine "Next"
fileThread.WriteLine "found = 0"
fileThread.WriteLine "Set objExcel = CreateObject(""Excel.Application"")"
fileThread.WriteLine "On Error Resume Next"
fileThread.WriteLine "Do While Found = 0"
fileThread.WriteLine "sout.WriteLine strCPWD"
fileThread.WriteLine "objExcel.Workbooks.Open strFilePath, , , ,strCPWD"
fileThread.WriteLine "If Err.Number = 1004 Then"
fileThread.WriteLine "strCPWD = NextPW(nCores)"
fileThread.WriteLine "Err.Clear"
fileThread.WriteLine "ElseIf Err.Number <> 0 Then"
fileThread.WriteLine "sout.WriteLine ""Other Error: "" & vbCrlf & ""Number: "" & Err.Number & vbCrlf & ""Description: "" & _"
fileThread.WriteLine "Err.Description & vbCrlf & ""Password: "" & Replace(strCPWD, "" "", ""{space}"")"
fileThread.WriteLine "Found = 1"
fileThread.WriteLine "Else"
fileThread.WriteLine "sout.WriteLine ""Password Found: "" & Replace(strCPWD, "" "", ""{space}"")"
fileThread.WriteLine "Found = 1"
fileThread.WriteLine "End If"
fileThread.WriteLine "Loop"
fileThread.WriteLine "On Error Goto 0"
fileThread.WriteLine "objExcel.Quit"
fileThread.WriteLine "Set objExcel = Nothing"
fileThread.WriteLine "Function NextPW(cores)"
fileThread.WriteLine "Dim i"
fileThread.WriteLine "pw(0) = pw(0) + cores"
fileThread.WriteLine "If pw(0) > 126 Then"
fileThread.WriteLine "pw(0) = pw(0) - 95"
fileThread.WriteLine "If pw(1) = 0 Then"
fileThread.WriteLine "pw(1) = 32"
fileThread.WriteLine "Else"
fileThread.WriteLine "pw(1) = pw(1) + 1"
fileThread.WriteLine "End If"
fileThread.WriteLine "End If"
fileThread.WriteLine "For i = 1 To 19"
fileThread.WriteLine "If pw(i) > 126 Then"
fileThread.WriteLine "pw(i) = 32"
fileThread.WriteLine "If pw(i+1) = 0 Then"
fileThread.WriteLine "pw(i+1) = 32"
fileThread.WriteLine "Else"
fileThread.WriteLine "pw(i+1) + 1"
fileThread.WriteLine "End If"
fileThread.WriteLine "End If"
fileThread.WriteLine "Next"
fileThread.WriteLine "For i = LBound(pw) To UBound(pw)"
fileThread.WriteLine "If pw(i) <> 0 Then NextPW = Chr(pw(i)) & NextPW"
fileThread.WriteLine "Next"
fileThread.WriteLine "End Function " For i = 1 To nCores
 objFSO.CopyFile strFilePath, strFilePath & i, True
 Set objDateTime = CreateObject("WbemScripting.SWbemDateTime")
 objDateTime.SetVarDate DateAdd("n", 1, Now())
 objWMI.Create "cmd /K cscript C:\ExcelCrackThread.vbs """ & strFilePath & i & """ " & nCores & " " & i, Null, Null, intJobID
Next