Macro to Insert Unique Password for Multiple Excel Files
thks, heard sth. about that
I did not think of Dir as an alternative solution
thanks a lot, Bernie!
On 25 Mar, 19:26, "Bernie Deitrick" <deitbe @ consumer dot org wrote:
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 -- Ukryj cytowany tekst -
- Pokaż cytowany tekst -
|