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