PDA

View Full Version : Solved: MS Excel: Password Problem



parttime_guy
08-12-2009, 11:29 PM
I have about 150 MS Excel files in my c drive.
All these files are password protected (they also have the same password)

I need some code to open each one of these files and using the known password?

After that do “Save As” go to Tools > General option and remove the password and save all the 150 files without a password

The next time I open any of these 150 files they should not have a password.

Is this possible on vba?

Thanks and Best regards

mdmackillop
08-12-2009, 11:59 PM
Try this

Sub RemPass()
Dim FName as String
Dim Pth As String
Dim wb as Workbook

Pth = "C:\AA\"
Pass = "bb"

FName = Dir(Pth & "*.xls")
Application.DisplayAlerts = False
Do Until FName = ""
Set wb = Workbooks.Open(Pth & FName, Password:=Pass)
wb.SaveAs Pth & FName, Password:=""
wb.Close
FName = Dir
Loop
Application.DisplayAlerts = True
End Sub

GTO
08-13-2009, 01:14 AM
Just another way, and really only because I was already (albeit slowly) typing...

I was thinking just in case you run into any workbooks that may have been forgotten and have a different password:


Option Explicit

Dim strFullName As String

Sub RemoveWBPWs()
Dim FSO As Object '<--- FileSystemObject
Dim FOL As Object '<--- Folder
Dim FIL As Object '<--- File
Dim wb As Workbook
Dim strPath As String

Const PWD As String = "12345" '<---Change to actual password

strPath = ThisWorkbook.Path & Application.PathSeparator '<---Change to suit

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FOL = FSO.GetFolder(strPath)

For Each FIL In FOL.Files
If FIL.Type = "Microsoft Excel Worksheet" Then

strFullName = FIL.Path
Set wb = WB_AttemptOpen(strFullName, PWD)
If Not wb Is Nothing Then
If wb.HasPassword Then
Application.DisplayAlerts = False
wb.SaveAs Filename:=strFullName, Password:=""
Application.DisplayAlerts = True
End If
wb.Close False
Else
If Not strFullName = ThisWorkbook.FullName Then
MsgBox strFullName & " has a different password..."
End If
End If
End If
Next
End Sub
Function WB_AttemptOpen(FName As String, PWD As String) As Workbook

If Not FName = ThisWorkbook.FullName Then
On Error GoTo errhndl
Set WB_AttemptOpen = Workbooks.Open(Filename:=FName, Password:=PWD)
On Error GoTo 0

End If
Exit Function
errhndl:
Set WB_AttemptOpen = Nothing

End Function


Probably not needed, but with as few thoughts that make it through my head....

Mark

parttime_guy
08-13-2009, 05:55 AM
Dear MD & Mark,

Thanks for your prompt response
I tried MD's code - it worked just perfectly

But... hey Mark no offence, I will try ur code too shortly

Can this code be put on the KB. It could be usefull to all users

u could name it: "Batch change/input of Passwords in MS Excel"

U guz r just 2 good.

Thx-n-BR :clap:

parttime_guy
08-14-2009, 08:01 PM
Hi Mark - sorry for the long delay, I tested ur code it to is working fine, a little advanced then MD's code - the file path is not required.

I was trying to make amendments to the Macro - to accept information from B3 and B4, but failed miserably (plz check attachement). :banghead:

Also - initially all the files require to be password protected (can the Macro run on files that are not password protected).

Kindly Help!

Thx-n-BR

GTO
08-15-2009, 12:12 AM
...the file path is not required.

I was trying to make amendments to the Macro - to accept information from B3 and B4, but failed miserably (plz check attachement). :banghead:

Also - initially all the files require to be password protected (can the Macro run on files that are not password protected).


Greetings,

The file path is req'd in either Malcom's or mine; I simply entered thisworkbook's path.

I believe/hope the following is what you are looking to do; but wasn't sure about your last statement/question. In short - AFAIK, you need to first open the file before testing for HasPassword. If when opening the workbooks, for any wb that does not currently have a password, Excel simply ignores the password arg in Workbboks.Open

If you want to assign the new password to workbooks that do not currently require/have a password, REM or delete the IF test as shown below.


Option Explicit

Dim strFullName As String

Sub RemoveWBPWs()
Dim FSO As Object '<--- FileSystemObject
Dim FOL As Object '<--- Folder
Dim FIL As Object '<--- File
Dim wb As Workbook
Dim strPath As String

Dim wksMACRO As Worksheet
Dim strOGPWD As String, strNewPWD As String

'// REM or delete this, as we'll use the passwords from the cells//
'Const PWD As String = "test" '<---Change to actual password

'// First, set a reference to the worksheet (or use the sheet's codename)//
Set wksMACRO = ThisWorkbook.Worksheets("MACRO")
'// Then get the values for the old and new passwords...//
strOGPWD = wksMACRO.Range("B3").Value
strNewPWD = wksMACRO.Range("B4").Value

'// Path to folder with the workbooks. //
strPath = ThisWorkbook.Path & Application.PathSeparator '<---Change to suit

'// Set a reference to FSO and the folder, so we can access the files property //
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FOL = FSO.GetFolder(strPath)

For Each FIL In FOL.Files
If FIL.Type = "Microsoft Excel Worksheet" Then

'// FIL.Path is the equivelant of FullName //
strFullName = FIL.Path

'// change the arg we send for the password to the string variable here, //
'// so that the value from B3 gets passed to the Function //
Set wb = WB_AttemptOpen(strFullName, strOGPWD)

If Not wb Is Nothing Then
'// I wasn't sure what you were mentioning as to the workbooks that do //
'// NOT initially have a password. As written, the code opens the wb, //
'// checks to see if it has a password, and if not, closes w/o changing.//
'// If you want to add the new password to wb's in the folder that do //
'// not currently have any password, simply remove these two lines: //
If wb.HasPassword Then '<--- Remove IF test to add new pwd to any //
' unpassworded wb's in the folder. //

Application.DisplayAlerts = False
wb.SaveAs Filename:=strFullName, Password:=strNewPWD '<---New password string
Application.DisplayAlerts = True
End If '<---

wb.Close False
Else
If Not strFullName = ThisWorkbook.FullName Then
MsgBox strFullName & " has a different password..."
End If
End If
End If
Next
End Sub

Function WB_AttemptOpen(FName As String, PWD As String) As Workbook

If Not FName = ThisWorkbook.FullName Then
On Error GoTo errhndl
Set WB_AttemptOpen = Workbooks.Open(Filename:=FName, Password:=PWD)
On Error GoTo 0

End If
Exit Function
errhndl:
Set WB_AttemptOpen = Nothing

End Function


Hope this helps,

Mark

parttime_guy
08-15-2009, 07:29 PM
Hi Mark,

Thanks for the new code
Iam still a beginner at vba, and the comments in the code really helped
It is great and just working perfect and will really help me in future

Thanks for all your help - n - :friends: Best regards

GTO
08-16-2009, 03:06 AM
:thumb You are very welcome, and I'm glad that the comments helped. Sometimes it is certainly a guess as to whether to include, so leastwise for me, don't hesitate to ask.

Have a great day!

Mark

parttime_guy
12-11-2009, 04:45 AM
The above code use to work with Excel 2003 (-perfectly-)

I am having problems with the above code in Excel 2007 (-Now-). It has just stopped working.:banghead:

Kindly help.

Thx-n-BR

GTO
12-11-2009, 05:55 PM
Hi Parttime,

Maybe a 'thick-head' moment for me, but I don't see anything that should blow up in 2007. Unfortunately I do not have access to 2007; hopefully someone with excel2007 can test.

You may wish to attach a new example wb with the code thats working in '03, but collapsing in the later ver.

Mark

parttime_guy
12-11-2009, 10:36 PM
Hi GTO,

I tried to simplify the SUB, ...... but ended up :banghead:

Kindly view the post below

http://www.vbaexpress.com/forum/showthread.php?t=29646

Pleezzz guide...... : pray2:

Thx-n-BR

parttime_guy
12-12-2009, 07:51 PM
Hi Guys,

Luckly – I found a machine in my office that had Excel 03 – I ran the code that GTO had provided earlier (without changes), it worked perfectly - the files were on a network drive. This code changes about 450+ files currently – n all these files have the same password.

I still gotta find out what’s the problem in running the code on Excel 07. Strange.

Thx-n-BR – catch u guz later on this one.