Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Remove password from multiple workbooks?
Hello
I have a large number of docs (500+) that I need to move to our company server. They are all encrypted with the same password, and I know the password, so I don't need a cracker program, but I am looking for a script or utility that will allow me to remove password protection from all of these docs at once. The below script does the trick for Word, courtesy Jay Freedman. I would like to convert it so that it works for Excel and Powerpoint. The key bit is to retain the fact the files are taken from a predefined source folder and moved, with passwords removed, to a target folder. many thanks! Misha Sub removePassword() Dim oDoc As Document Dim fName As String Const pwd = "password" ' to be changed Const pathToOpen = "C:\passwordFiles\" ' to be changed Const pathToSave = "C:\noPassword\" ' to be changed fName = Dir$(pathToOpen & "*.doc") If fName = "" Then MsgBox "No *.doc files in " & pathToOpen End If WordBasic.DisableAutoMacros 1 ' disable any AutoOpen On Error GoTo FinalExit While fName < "" Set oDoc = Documents.Open(FileName:=pathToOpen & fName, _ PasswordDocument:=pwd, AddToRecentFiles:=False) oDoc.SaveAs FileName:=pathToSave & fName, Password:="" oDoc.Close SaveChanges:=wdDoNotSaveChanges fName = Dir$() Wend Exit Sub FinalExit: WordBasic.DisableAutoMacros 0 ' reenable If Err.Number < 0 Then Select Case Err.Number Case 5152: MsgBox "Could not save " & pathToSave & fName Case Else MsgBox Err.Number & vbCr & Err.Description End Select End If End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Remove password from multiple workbooks?
Untested but try this
Sub removePasswordexcel() Dim oDoc As Workbook Dim fName As String Const pwd = "password" ' to be changed Const pathToOpen = "C:\passwordFiles\" ' to be changed Const pathToSave = "C:\noPassword\" ' to be changed fName = Dir$(pathToOpen & "*.xls") If fName = "" Then MsgBox "No *.xls files in " & pathToOpen End If Application.ScreenUpdating = False Application.EnableEvents = False ' disable any AutoOpen On Error GoTo FinalExit While fName < "" Set oDoc = Workbooks.Open(Filename:=pathToOpen & fName, _ Password:=pwd) oDoc.SaveAs Filename:=pathToSave & fName, Password:="" oDoc.Close SaveChanges:=False fName = Dir$() Wend Exit Sub FinalExit: Application.EnableEvents = True ' reenable Application.ScreenUpdating = True If Err.Number < 0 Then Select Case Err.Number Case 5152: MsgBox "Could not save " & pathToSave & fName Case Else MsgBox Err.Number & vbCr & Err.Description End Select End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm wrote in message ... Hello I have a large number of docs (500+) that I need to move to our company server. They are all encrypted with the same password, and I know the password, so I don't need a cracker program, but I am looking for a script or utility that will allow me to remove password protection from all of these docs at once. The below script does the trick for Word, courtesy Jay Freedman. I would like to convert it so that it works for Excel and Powerpoint. The key bit is to retain the fact the files are taken from a predefined source folder and moved, with passwords removed, to a target folder. many thanks! Misha Sub removePassword() Dim oDoc As Document Dim fName As String Const pwd = "password" ' to be changed Const pathToOpen = "C:\passwordFiles\" ' to be changed Const pathToSave = "C:\noPassword\" ' to be changed fName = Dir$(pathToOpen & "*.doc") If fName = "" Then MsgBox "No *.doc files in " & pathToOpen End If WordBasic.DisableAutoMacros 1 ' disable any AutoOpen On Error GoTo FinalExit While fName < "" Set oDoc = Documents.Open(FileName:=pathToOpen & fName, _ PasswordDocument:=pwd, AddToRecentFiles:=False) oDoc.SaveAs FileName:=pathToSave & fName, Password:="" oDoc.Close SaveChanges:=wdDoNotSaveChanges fName = Dir$() Wend Exit Sub FinalExit: WordBasic.DisableAutoMacros 0 ' reenable If Err.Number < 0 Then Select Case Err.Number Case 5152: MsgBox "Could not save " & pathToSave & fName Case Else MsgBox Err.Number & vbCr & Err.Description End Select End If End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Remove password from multiple workbooks?
skrev i en meddelelse ... Hello I have a large number of docs (500+) that I need to move to our company server. They are all encrypted with the same password, and I know the password, so I don't need a cracker program, but I am looking for a script or utility that will allow me to remove password protection from all of these docs at once. The below script does the trick for Word, courtesy Jay Freedman. I would like to convert it so that it works for Excel and Powerpoint. The key bit is to retain the fact the files are taken from a predefined source folder and moved, with passwords removed, to a target folder. many thanks! Misha Sub removePassword() Dim oDoc As Document Dim fName As String Const pwd = "password" ' to be changed Const pathToOpen = "C:\passwordFiles\" ' to be changed Const pathToSave = "C:\noPassword\" ' to be changed fName = Dir$(pathToOpen & "*.doc") If fName = "" Then MsgBox "No *.doc files in " & pathToOpen End If WordBasic.DisableAutoMacros 1 ' disable any AutoOpen On Error GoTo FinalExit While fName < "" Set oDoc = Documents.Open(FileName:=pathToOpen & fName, _ PasswordDocument:=pwd, AddToRecentFiles:=False) oDoc.SaveAs FileName:=pathToSave & fName, Password:="" oDoc.Close SaveChanges:=wdDoNotSaveChanges fName = Dir$() Wend Exit Sub FinalExit: WordBasic.DisableAutoMacros 0 ' reenable If Err.Number < 0 Then Select Case Err.Number Case 5152: MsgBox "Could not save " & pathToSave & fName Case Else MsgBox Err.Number & vbCr & Err.Description End Select End If End Sub Hi Misha Try this Sub removePassword() Dim oWB As Workbook Dim fName As String Const pwd = "password" ' to be changed Const pathToOpen = "C:\passwordFiles\" ' to be changed Const pathToSave = "C:\noPassword\" ' to be changed Dim secAutomation As MsoAutomationSecurity secAutomation = Application.AutomationSecurity fName = Dir$(pathToOpen & "*.xls") If fName = "" Then MsgBox "No *.xls files in " & pathToOpen End If Application.AutomationSecurity = msoAutomationSecurityForceDisable ' Disable macros, should work in excel 2003 On Error GoTo FinalExit While fName < "" Set oWB = Workbooks.Open(Filename:=pathToOpen & fName, _ Password:=pwd, AddToRecentFiles:=False) oWB.SaveAs Filename:=pathToSave & fName, Password:="" oWB.Close SaveChanges:=wdDoNotSaveChanges fName = Dir$() Wend Exit Sub FinalExit: Application.AutomationSecurity = secAutomation 'Enabel macros If Err.Number < 0 Then Select Case Err.Number Case 5152: MsgBox "Could not save " & pathToSave & fName Case Else MsgBox Err.Number & vbCr & Err.Description End Select End If End Sub Regards, Per |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to password protect multiple workbooks? | Excel Discussion (Misc queries) | |||
Password Protect Multiple Workbooks | Excel Discussion (Misc queries) | |||
Remove multiple workbooks | Excel Discussion (Misc queries) | |||
Admin Password for multiple workbooks | Excel Discussion (Misc queries) | |||
linking to multiple password protected workbooks | Excel Programming |