if I know the password, how do I remove it from a large no of docs?

[misha.lepetic]

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 thought of doing them all one by one is pretty unappealing.
Thanks!

chrs
|m|

 

[Jay Freedman]

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 thought of doing them all one by one is pretty unappealing.
Thanks!

chrs

Use this macro (see http://www.gmayor.com/installing_macro.htm if needed):

Sub demo()
Dim oDoc As Document
Dim fName As String
Const pwd = "MyPaSsWoRd" ' to be changed
Const pathToOpen = "C:\temp\" ' to be changed
Const pathToSave = "C:\temp1\" ' 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


You'll have to enter the real password and the paths to the folders for the
original and "de-passworded" files. The macro could probably use some more
error handling, but this may be sufficient. Note that it will stop as soon
as there's any error and not go on to any more files; after fixing the
problem, remove any files from the source folder that have already been
processed, and then restart the macro.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.

 

[misha.lepetic]

Jay

Thanks very much. The code makes sense to me but when I install and
run it, it doesn't recognize any filenames and terminates at the
MsgBox "No *.doc files in " & pathToOpen". I installed it as a module
and even created a test.doc file with the same password. What am I
missing here?

|m|

 

[Jay Freedman]

Did you change the lines

Const pwd = "MyPaSsWoRd" ' to be changed
Const pathToOpen = "C:\temp\" ' to be changed
Const pathToSave = "C:\temp1\" ' to be changed

to the actual password and folders to be used? If so, are you sure the value
you assigned to pathToOpen is exactly correct, and is there a backslash at
the end of it? If that path doesn't match the path to an existing folder, or
if the backslash is missing, you'll get that same message as if the path was
right but the folder was empty.

Unfortunately, it's impossible to look inside the built-in Dir$() function
and ask it why it isn't matching anything when you think it should be. You
have to kind of poke around the edges to see if you can spot something odd.
For example, you could declare another string

Dim initFname As String

and then replace the line

fName = Dir$(pathToOpen & "*.doc")

with

initFname = pathToOpen & "*.doc"
fName = Dir$(initFname)

Then you can set a breakpoint (press F9) on the second of those two lines
and run the macro. When it stops at the breakpoint, hover the mouse over the
word initFname to look at the value being passed into Dir$(). Verify that it
matches the folder path, and that it properly has a backslash between the
folder name and the *.doc. Press F8 to execute the breakpointed line, and
look at the resulting value of fName. If everything else is right, it
_should_ contain the name of a doc file in the folder; if it's an empty
string, Dir$() is saying that it didn't find anything at the specified
location.

 

[misha.lepetic]

Jay

Thanks again - I had omitted the concluding backslashes in the source
and target folders. The script works very well now. I've been able to
further amend the paths so that I can run the conversion on the
network drive itself.

To extend this concept into Excel and Powerpoint files, would I just
need to replace "*.doc" with "*.xls" and "*.ppt" and install the macro
in the relevant applications? If it's not that simple, I can post to
the respective groups for further tweaking.

Of course, the best solution would be the ability to run the process
for all three applications from one script, but that may be asking too
much.

many thanks
|m|

 

[misha.lepetic]

Jay

Thanks again - I had omitted the concluding backslashes in the source
and target folders. The script works very well now. I've been able to
further amend the paths so that I can run the conversion on the
network drive itself.

To extend this concept into Excel and Powerpoint files, would I just
need to replace "*.doc" with "*.xls" and "*.ppt" and install the macro
in the relevant applications? If it's not that simple, I can post to
the respective groups for further tweaking.

Of course, the best solution would be the ability to run the process
for all three applications from one script, but that may be asking too
much.

many thanks
|m|

 

[Jay Freedman]

Unfortunately, each program is a little different, so it isn't just a matter of
changing the file extension. For Excel, you would need to change "Document" to
"Workbook"; some of the names of the arguments and constants are different; and
the WordBasic functions have to be removed. Here's the modified version:

Sub demoXL()
Dim oDoc As Workbook
Dim fName As String
Const pwd = "MyPaSsWoRd" ' to be changed
Const pathToOpen = "C:\temp\" ' to be changed
Const pathToSave = "C:\temp1\" ' to be changed

fName = Dir$(pathToOpen & "*.xls")
If fName = "" Then
MsgBox "No *.xls files in " & pathToOpen
End If

On Error GoTo FinalExit

While fName <> ""
Set oDoc = Workbooks.Open(Filename:=pathToOpen & fName, _
Password:=pwd, AddToMRU:=False)
oDoc.SaveAs Filename:=pathToSave & fName, Password:=""
oDoc.Close SaveChanges:=xlDoNotSaveChanges
fName = Dir$()
Wend

Exit Sub

FinalExit:

If Err.Number <> 0 Then
Select Case Err.Number
Case 1004:
MsgBox "Could not save " & pathToSave & fName
Case Else
MsgBox Err.Number & vbCr & Err.Description
End Select
End If
End Sub

I haven't looked at the PowerPoint version, but it would need some similar
adjustments.

It would be possible to write the three separate macros, each in its own
application, and then use VBScript to call each of them in turn.

 

[misha.lepetic]

Jay

Thanks for your response again. It works great. The only difference is
that I have to run it from the specific spreadsheet, as Excel does not
allow macros to be applied to the global Excel template.

Incidentally, the Powerpoint object model doesn't reveal the Password
property, therefore this kind of operation is not possible in that
application.

Thanks again for your help.

|m|