View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
Bernie Deitrick Bernie Deitrick is offline
external usenet poster
 
Posts: 5,441
Default Macro to Insert Unique Password for Multiple Excel Files

Jarek,

Filesearch was removed from Excel 2007. The function Dir still works. Here's some example code....

Sub HowToUseDir()

Dim WorkFile As String
Dim colAT As Integer
Dim rowAT As Long
Dim booCHK As Boolean
Dim txtDIRECTORY As String
Dim strFILEEXT As String
Dim myBook As Workbook

txtDIRECTORY = "C:\Excel\" ' note final "\"

strFILEEXT = "*.xls"
colAT = 1
rowAT = 2
booCHK = True

If booCHK Then

WorkFile = Dir(txtDIRECTORY & strFILEEXT)

If WorkFile = "" Then
MsgBox "That folder is empty."
Exit Sub
End If

Do While WorkFile < ""
'Create a listing
Cells(rowAT, colAT) = txtDIRECTORY & WorkFile
'If you want to open the file, use
'Set myBook = Workbooks.Open(txtDIRECTORY & WorkFile)
rowAT = rowAT + 1
WorkFile = Dir()
Loop


End If

End Sub


--
HTH,
Bernie
MS Excel MVP


"Jarek Kujawa" wrote in message
...
Bern,
what might be the possible reason for below sub not working in my
Excel 2007? though it worked in Excel 2003

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


On 25 Mar, 17:03, "Bernie Deitrick" <deitbe @ consumer dot org wrote:
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.- Ukryj cytowany tekst -


- Pokaż cytowany tekst -