View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Remove passwords from many workbooks

Option Explicit
Sub testme()

Dim myPWD As Variant
Dim pCtr As Long
Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim tempWkbk As Workbook
Dim logWks As Worksheet
Dim oRow As Long

myPWD = Array("", "aaa", "bbb", "CCC")

Set logWks = Workbooks.Add(1).Worksheets(1)
With logWks
.Name = "Log_" & Format(Now, "yyyymmdd_hhmmss")
.Range("a1:c1").Value _
= Array("WorkbookName", "Password", "Msg")
End With

oRow = 1

'change to point at the folder to check
myPath = "c:\my documents\excel\test"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then
Application.EnableEvents = False
For fCtr = LBound(myFiles) To UBound(myFiles)
Application.StatusBar _
= "Processing: " & myFiles(fCtr) & " at: " & Now
Set tempWkbk = Nothing
For pCtr = LBound(myPWD) To UBound(myPWD)
On Error Resume Next
Set tempWkbk = Workbooks.Open(Filename:=myPath & myFiles(fCtr),
_
Password:=myPWD(pCtr))
On Error GoTo 0

If tempWkbk Is Nothing Then
'keep trying
Else
Exit For
End If
Next pCtr

oRow = oRow + 1
logWks.Cells(oRow, "A").Value = myPath & myFiles(fCtr)

If tempWkbk Is Nothing Then
'couldn't open it for some reason
logWks.Cells(oRow, "C").Value = "Error opening workbook"
Else
logWks.Cells(oRow, "B").Value = myPWD(pCtr)
If myPWD(pCtr) = "" Then
'do nothing special
Else
With tempWkbk
Application.DisplayAlerts = False
.SaveAs Filename:=myPath & myFiles(fCtr), Password:=""
Application.DisplayAlerts = True
End With
End If
tempWkbk.Close savechanges:=False
End If
Next fCtr
Application.EnableEvents = True
logWks.UsedRange.Columns.AutoFit
Else
logWks.Parent.Close savechanges:=False
End If

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

Change the path and the passwords.

By keeping a "" in the passwords list, the code won't need to save the file for
those files with no password.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

wrote:

Yeah but that might take just as long as removing the passwords manually. Is
there any quick solution?

Thanks

Adam Bush

"Dave Peterson" wrote:

Can you build the list of workbook names and passwords?

wrote:

All the files are in the same folder, however there might be some files in
the folder that do not have passwords. Also, the passwords do differ, but
there are only three.

Thanks

Adam Bush

"Dave Peterson" wrote:

Are all 360 workbook files in a single folder?
Are there other files in that folder that should not be touched?
Do they all have the same password?

As a worst case scenario, I'd build a table on a worksheet.

I'd put the full name (drive, path, filename) in column A and the associated
password in column B.

Then have a macro that looks through that table and opens the workbook and saves
without the password.



wrote:

I have a bout 360 workbooks that all have passwords. Now I want to remove
these passwords. I know what the passwords are, I just want to remove them
all without having to open every individual file. Any suggestions?

Thanks

Adam Bush

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson