Search This Blog

Sunday 1 March 2009

Code that will stop your brain to work on excel

The below code can be used to crack the excel worksheet password. It may not give the original password but will provide an alternate password that can be used to unprotect the worksheet.Steps:Open the excel workbook that has the protected sheet in it. Select Alt+F11 to open the Visual Basic Editor. Select Insert->Module and paste the below code into the code window:
Sub Excel_Password_Breaker()'Author unknownDim i As Integer, j As Integer, k As IntegerDim l As Integer, m As Integer, n As IntegerDim i1 As Integer, i2 As Integer, i3 As IntegerDim i4 As Integer, i5 As Integer, i6 As IntegerOn Error Resume NextFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)If ActiveSheet.ProtectContents = False ThenMsgBox "One usable password is " & Chr(i) & Chr(j) & _Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)ActiveWorkbook.Sheets(1).SelectRange("a1").FormulaR1C1 = Chr(i) & Chr(j) & _Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)Exit SubEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextEnd SubClose the VB Editor and go to the worksheet you want to unprotect and press Alt+f8 and double click the Excel_Password_Breaker in the list.

coder: Smith solace

special note: just if you dont understand copy it and paste in to the notepad it wil be in propermannner sattled so you can read it.

The following tutorial shows how to protect/unprotect the excel sheet using macroYou have to pass the excel sheet name to the following functions to protect/unprotect the sheetCode to fetch the sheet name:
ThisWorkbook.ActiveSheet.NameCode to unprotect sheet


Public Sub Unprotect_Sheet(sname)Sheets(sname).Unprotect Password:="password"End

SubCode to protect sheet

Public Sub Protect_Sheet(sname)Sheets(sname).Protect Password:="password"End Sub

Chaos Revealed Get the codes

This is the one blog i have created for the publishing new techniques and for masala relating to the computer.


grab the codes for computers.

The following code shows how to read values and formula from cells in a closed workbook and insert into another using MS Excel macro


Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, i As Integer
FolderName = "C:\Foldername"
' create list of workbooks in foldername
wbCount = 0
wbName = Dir(FolderName & "" & "*.xls")
While wbName <> ""
wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = wbName
wbName = Dir
Wend
If wbCount = 0 Then Exit Sub
' get values from each workbook
r = 0
Workbooks.Add
For i = 1 To wbCount
r = r + 1
cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Sheet1", "A1")
Cells(r, 1).Formula = wbList(i)
Cells(r, 2).Formula = cValue
Next i
End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "" Then wbPath = wbPath & ""
If Dir(wbPath & "" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function


This method has some limitations on how many cells you can return information from since the Excel4-macro creates links to the closed workbook. You can use a similar example using ADO if you need to retrieve a lot of data from a closed workbook.

It is often much easier to open the workbook and get the information from it. If you set the Application.ScreenUpdating to False, the user will probably not notice that the workbook is opened and closed again.


Sub GetDataFromClosedWorkbook()
Dim wb As Workbook
Application.ScreenUpdating = False ' turn off the screen updating
Set wb = Workbooks.Open("C:\Foldername\Filename.xls", True, True)
' open the source workbook, read only
With ThisWorkbook.Worksheets("TargetSheetName")
' read data from the source workbook
.Range("A10").Formula = wb.Worksheets("SourceSheetName").Range("A10").Formula
.Range("A11").Formula = wb.Worksheets("SourceSheetName").Range("A20").Formula
.Range("A12").Formula = wb.Worksheets("SourceSheetName").Range("A30").Formula
.Range("A13").Formula = wb.Worksheets("SourceSheetName").Range("A40").Formula
End With
wb.Close False ' close the source workbook without saving any changes
Set wb = Nothing ' free memory
Application.ScreenUpdating = True ' turn on the screen updating
End Sub


Here is another variant:


Sub CopyFromClosedWB(strSourceWB As String, _
strSourceWS As String, strSourceRange As String, _
rngTarget As Range)
' copies information from a closed workbook, no input validation!
' use like this to copy information to the active worksheet:
' CopyFromClosedWB "C:\Foldername\Filename.xls", "Sheet1", "A1:D100", Range("A1")
Dim wb As Workbook
Application.ScreenUpdating = False ' turn off the screen updating
Application.StatusBar = "Copying data from " & strSourceWB & "..."
On Error Resume Next ' ignore errors
' open the source workbook, read only
Set wb = Workbooks.Open(strSourceWB, True, True)
On Error GoTo 0 ' stop when errors occur
If Not wb Is Nothing Then ' opened the workbook
On Error Resume Next ' ignore errors
With wb.Worksheets(strSourceWS).Range(strSourceRange)
.Copy rngTarget
End With
On Error GoTo 0 ' stop when errors occur
wb.Close False ' close the source workbook without saving changes
Set wb = Nothing ' free memory
End If
Application.StatusBar = False ' reset status bar
Application.ScreenUpdating = True ' turn on the screen updating
End Sub

Sub TestCopyFromClosedWB()
CopyFromClosedWB "C:\Foldername\Filename.xls", _
"SheetName", "A1:D10", Range("A1")
End Sub