' ***************************************************************
' * ExcelPWDRecovery.vbs  By Vittorio Pavesi (www.vittorio.tk) 	*
' *								* 
' * Open Excel and simulate key pression to enter password  	*
' * it use a dictionary attack from a plain text file    	*
' ***************************************************************

ExcelFile = """c:\Documents and Settings\vittorio\Desktop\Book1.xls"""  'Double quotes needed only for path containing spaces
ExcelTitle = "Microsoft Excel - Book1.xls"
PasswordListFile = "c:\Documents and Settings\vittorio\Desktop\pwd.txt"  'a plain text file containing a password for every row
Interval = 200 'milliseconds

Dim filesys, filetxt
Const ForReading = 1, ForWriting = 2, ForAppending = 8 
Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile(PasswordListFile, ForReading, True) 
set WshShell = CreateObject("WScript.Shell")

startMe

sub startMe
while not WshShell.AppActivate(ExcelTitle) 
    if filetxt.AtEndOfStream then
        msgbox("Password not found")
        filetxt.Close 
        exit sub
    else
        PWD = filetxt.Readline
        OpenExcel
        sendPWD(PWD)
        if not WshShell.AppActivate(ExcelTitle) then
            WshShell.Sendkeys "{ENTER}"
            WScript.Sleep Interval
        end if
    end if
wend
msgbox ("Password Found !" & vbcrlf & "(" & PWD & ")")
end sub

Sub OpenExcel
    WshShell.Run ExcelFile
    While WshShell.AppActivate("Password") = FALSE
        wscript.sleep 100
    Wend
End sub

Sub SendPWD(byval password)
    'wscript.echo "Trying password: " & password
    for i = 1 to len(password)
        WshShell.SendKeys mid(password,i,1)
    next 
    WshShell.Sendkeys "{ENTER}"
end sub