Excel workbooks Open password Cracker Code

Sub PasswordBreaker()
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
Filename = Application.GetOpenFilename(filefilter:="workbooks *.xls,*.xls")
For i = 1 To Len(Filename)
If Mid(Filename, i, 1) = "\" Then
mylen = i
End If
Next
wbkname = Right(Filename, Len(Filename) - mylen)
For i = 32 To 126: For j = 32 To 126: For k = 32 To 126
For l = 32 To 126: For m = 32 To 126: For i1 = 32 To 126
For i2 = 32 To 126: For i3 = 32 To 126: For i4 = 32 To 126
For i5 = 32 To 126: For i6 = 32 To 126: For n = 32 To 126


pswd = Trim(Chr(n) & Chr(i6) & Chr(i5) & _
Chr(i4) & Chr(i3) & Chr(i2) & Chr(i1) & Chr(m) & _
Chr(l) & Chr(k) & Chr(j) & Chr(i))
Workbooks.Open Filename
Application.StatusBar = pswd
DoEvents
If ActiveWorkbook.Name = wbkname Then
MsgBox "One usable password is " & Trim(Chr(n) & Chr(i6) & Chr(i5) & _
Chr(i4) & Chr(i3) & Chr(i2) & Chr(i1) & Chr(m) & _
Chr(l) & Chr(k) & Chr(j) & Chr(i))
Application.StatusBar = False
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next

End Sub

---

Looking for local information? Find it on Yahoo! Local

Reading outlook emails from Shared Mailbox

Add reference Microsoft Outlook XX.X object Library

Sub OutlookTesting()

Dim folders As Outlook.folders
Dim folder As Outlook.MAPIFolder
Dim iRow As Integer
Dim Pst_Folder_Name
Dim MailboxName
Dim UnRow As Integer
Dim RESS As Outlook.Recipient
Dim Flag As Integer
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olfldr As Outlook.MAPIFolder
Dim foldername As Outlook.MAPIFolder
Dim sharedemail As Outlook.Recipient
Const SharedMailboxName As String = "abc@xyz.com" '  <-- font="" mailbox="" name="" shared="" your="">
<-- mailbox="" name="" p="" shared="" your="">
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set sharedemail = olNS.CreateRecipient(SharedMailboxName)

For x = 1 To olNS.Stores.Count  ' <-- all="" and="" configured="" i="" iterate="" mailbox="" mailboxes="" on="" outlook="" select="" target="" thorough=""><-- all="" and="" configured="" iterate="" mailbox="" mailboxes="" on="" outlook="" p="" select="" target="" thorough="">
    If olNS.Stores.Item(x).DisplayName = SharedMailboxName Then
        Set olfldr = olNS.Stores.Item(x).GetDefaultFolder(olFolderInbox)
    End If

Next

Set folder = olfldr

If folder = "" Then
   MsgBox "Invalid Data in Input"
   GoTo end_lbl1:
End If

'Read Through each Mail and export the details to Excel for Email Archival
Count = 1

For iRow = folder.Items.Count To 1 Step -1

    If (folder.Items(iRow).UnRead) Then
     
        ActiveSheet.Cells(Count + 1, 1).Value = folder.Items(iRow).SenderEmailAddress
        ActiveSheet.Cells(Count + 1, 2).Value = folder.Items(iRow).Subject
        ActiveSheet.Cells(Count + 1, 3).Value = folder.Items(iRow).To
        ActiveSheet.Cells(Count + 1, 4).Value = folder.Items(iRow).Body
        ActiveSheet.Cells(Count + 1, 5).Value = folder.Items(iRow).ReceivedTime
        ActiveSheet.Cells(Count + 1, 6).Value = folder.Items(iRow).SentOn
        ActiveSheet.Cells(Count + 1, 7).Value = folder.Items(iRow).Sensitivity
     
        Count = Count + 1

    End If
 
 
Next iRow
MsgBox "Outlook Mails Extracted to Excel"
end_lbl1:
End Sub