#1
|
|||
|
|||
Removing password protection
Using Office 2007, I have a folder containing sub folders and these contain some 850 Word files. Each file is password protected. I have to enter the password to open the file and then enter it again to modify the file. I know the password and it is the same for all 850 files.
Is there a way to remove the password requirements from all the files in one go without having to open each file and enter the password 1700 times! |
#2
|
||||
|
||||
Hi HantsDave,
Try: Code:
Sub UnprotectDocuments() Application.ScreenUpdating = False Dim strFolder As String, strPwd As String, strFile As String, wdDoc As Document strPwd = InputBox("What is the password?", "File Password") If strPwd = "" Then Exit Sub strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, _ Visible:=False, PasswordDocument:=strPwd) If wdDoc.ProtectionType <> wdNoProtection Then wdDoc.Unprotect wdDoc.Close SaveChanges:=True strFile = Dir() Wend Set wdDoc = Nothing Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thanks Macropod but after entering the code into the Visual Basic window and running it, it takes me to each file and asks for the password; remember that when I go to a file normally I have to enter the password twice: first to open the file and then again to modify. So it is eliminating one password entry but not the other.
Also now when I open any Word document I get a window 'The command cannot be performed because a dialog box is open. Click OK, and then close open dialog boxes to continue'. This doesn't happen if I open a blank doc using a link to the winword.exe file. Any thoughts? Thanks again, from a cold Hampshire in the UK |
#4
|
||||
|
||||
It appears the code I provided would only remove forms protection, not the open/write protection. Try the following instead:
Code:
Sub UnprotectDocuments() Application.ScreenUpdating = False Dim strFolder As String, strPwd As String, strFile As String, wdDoc As Document strPwd = InputBox("What is the password?", "File Password") If strPwd = "" Then Exit Sub strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, _ Visible:=False, PasswordDocument:=strPwd, WritePasswordDocument:=strPwd) With wdDoc '.ReadOnlyRecommended = False .Password = vbNullString .WritePassword = vbNullString .Close SaveChanges:=True End With strFile = Dir() Wend Set wdDoc = Nothing Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Hi Macropod, yes that works great. In fact you have to go to each folder, it won't look into sub-folders but it did the job and saved a huge amount of time.
As for the error dialog box, I have discovered that by pure coincidence an update to Norton Internet Security 2012 came along the same day as I tried your first code; seems the Norton officeav.dll file is causing some problems and there are plenty of posts about it on the Internet. Disabling the Microsoft Office scan option in Norton stops it but how strange that it came along the same time as your code! Thanks again from a cold Hampshire UK |
#6
|
|||
|
|||
Hello Macropod,
I too was able to use your code,I'm glad Hantsdave started the thread. I posted a similar one and was directed to yours. The code works great for me (I have 150 +/- files to remove PW from)with the exception that I'm being prompted at each file save with a dilalogue box "this file is being saved with tracked changes".I hit ok and it moves on to the next file in the directory .I'd rather have it save only the "Final" Views,but seems as if it defaults to save with "Final showing Markups".How can I input into the code to automatically select FINAL? Thanks! |
#7
|
||||
|
||||
Hi,
That warning is part of how you have Word configured. It can be disabled temporarily, with the following code mods. Starting with the end of the 'Dim' line, add the following: Code:
, TrkStatus As Boolean TrkStatus = Options.WarnBeforeSavingPrintingSendingMarkup Options.WarnBeforeSavingPrintingSendingMarkup = False Code:
Options.WarnBeforeSavingPrintingSendingMarkup = TrkStatus Code:
Application.ScreenUpdating = True
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
Thanks Macropod for the quick response.Please forgive my lack of knowledge here,but I'm thinking I may have inserted the first bit of code you provided in the wrong spot
.Here's the code as I have it now: Code:
Sub UnprotectDocuments() Application.ScreenUpdating = False Dim strFolder As String, strPwd As String, strFile As String, wdDoc As Document strPwd = InputBox("What is the password?", "maude#1") If strPwd = "" Then Exit Sub strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, _ Visible:=False, PasswordDocument:=strPwd, WritePasswordDocument:=strPwd) With wdDoc '.ReadOnlyRecommended = False .Password = vbNullString .WritePassword = vbNullString ,TrkStatus As Boolean TrkStatus = Options.WarnBeforeSavingPrintingSendingMarkup Options.WarnBeforeSavingPrintingSendingMarkup = False .Close SaveChanges:=True End With strFile = Dir() Wend Set wdDoc = Nothing Options.WarnBeforeSavingPrintingSendingMarkup = TrkStatus Application.ScreenUpdating = True End Sub Last edited by cure4glass; 03-07-2012 at 05:56 AM. Reason: typo |
#9
|
||||
|
||||
Hi,
Your code's not right. It should be: Code:
Sub UnprotectDocuments() Application.ScreenUpdating = False Dim strFolder As String, strPwd As String, strFile As String, wdDoc As Document, TrkStatus As Boolean TrkStatus = Options.WarnBeforeSavingPrintingSendingMarkup Options.WarnBeforeSavingPrintingSendingMarkup = False strPwd = InputBox("What is the password?", "File Password") If strPwd = "" Then Exit Sub strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, _ Visible:=False, PasswordDocument:=strPwd, WritePasswordDocument:=strPwd) With wdDoc '.ReadOnlyRecommended = False .Password = vbNullString .WritePassword = vbNullString .Close SaveChanges:=True End With strFile = Dir() Wend Set wdDoc = Nothing Options.WarnBeforeSavingPrintingSendingMarkup = TrkStatus Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#10
|
|||
|
|||
Thanks Macropod, That worked great. I have another question building on what you provided but I will repost as a separate item.
Thanks again! |
Tags |
password, protection, remove |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Did an auto-update remove password protection? | namedujour | Excel | 0 | 11-22-2011 07:40 AM |
Password Protection Problem | todobfl | Excel | 4 | 07-26-2011 06:40 PM |
Password Protection | JimP | Visio | 2 | 03-24-2011 04:23 AM |
Help reg Protection of cell. | aligahk06 | Excel | 1 | 09-02-2009 05:45 PM |
Visio - password protection | icap5183 | Visio | 0 | 07-24-2009 06:00 AM |