View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
ScottMSP ScottMSP is offline
external usenet poster
 
Posts: 34
Default Macro to Insert Unique Password for Multiple Excel Files

I found the solution and thought I would post it. Thanks to Bernie for
leading the way...

Sub AssignPasswords()
Dim myB As Workbook
Dim myPW As String
Dim myC As Range
Dim ws As Worksheet

For Each myC In Range("A2", Cells(Rows.Count, 1).End(xlUp))
myPW = myC.Offset(0, 1).Value
Set myB = Workbooks.Open(myC.Value)
myB.Password = myPW
myB.Save
myB.Close
Next myC

End Sub

"ScottMsp" wrote:

Bernie,

Thanks for patience, but one more question.

I am not sure what you are suggesting in your latest post, but I have made
an attempt to modify the macro based on some further research. Perhaps you
can recommend tweaks to it to make it run (currently it does not work).

Thanks again.

Sub AssignPasswords()
Dim myB As Workbook
Dim myPW As String
Dim myC As Range
Dim ws As Worksheet

For Each myC In Range("A2", Cells(Rows.Count, 1).End(xlUp))
myPW = myC.Offset(0, 1).Value
Set myB = Workbooks.Open(myC.Value)
myB.SaveAs Filename:="My File Path" & ws.Name, Password:=myPW
myB.Close
Next myC

End Sub

"Bernie Deitrick" wrote:

Sorry, no password is required to open the workbook based on that setting, just to change the
workbook's structure.

Add or change to

myB.Password = myPW 'Password To Open
myB.WritePassword = myPW 'Password to write


HTH,
Bernie
MS Excel MVP


"ScottMsp" wrote in message
...
Bernie,

I did as instructed. The macro ran, but when I went to open up the file, no
password was required.

Thoughts?


"Bernie Deitrick" wrote:

Forgot to close the file. After

myB.Save

insert

myB.Close

HTH,
Bernie
MS Excel MVP


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Scott,

Do you have a list of the files as well?

Say you have a list of the workbooks' full names (including path) starting in cell A2, down
column
A, with the proposed passwords in column B of the same row.

Then you could run the macro below.

If you don't have the file list, you could run the second macro below to create it.

HTH,
Bernie
MS Excel MVP

Sub AssignPasswords()
Dim myB As Workbook
Dim myPW As String
Dim myC As Range

For Each myC In Range("A2", Cells(Rows.Count, 1).End(xlUp))
myPW = myC.Offset(0, 1).Value
Set myB = Workbooks.Open(myC.Value)
myB.Protect Password:=myPW, Structu=True, Windows:=False
myB.Save
Next myC

End Sub


Sub ListFiles()
Dim i As Integer

With Application.FileSearch
.NewSearch
.LookIn = "C:\Excel\Folder Name"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
Cells(i + 1, 1).Value = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub


"ScottMsp" wrote in message
...
Hello,

I have 200+ Excel files that I need to password protect with a unique
password for each file. I have the passwords prepared, I am not sure how to
write the macro to look at a list and set the password for each file to the
unique password I have assigned to it.

Thanks in advance.