Hi...
I've got a large number of non-password protected Excel files that I'd like
to password-protect. Does anyone know of a way to batch this process? I'd
like to apply the same password to each file. This would be very tedious
doing them one-by-one. Any help greatly appreciated.
Thanks...
Gary

Gary, can I ask what do you want to protect?

WorkBooks? , WorkSheets or VBAProjects

--
Message posted from http://www.ExcelForum.com

These are xls files (workbooks?) with confidential compensation information
in them. Some have multiple worksheets, some don't.
Gary


"Colo " wrote in message
...
Gary, can I ask what do you want to protect?

WorkBooks? , WorkSheets or VBAProjects?


---
Message posted from http://www.ExcelForum.com/

Hi Gary, Here is a sample for Protecting/Unprotecting Workbooks an
Worksheets.
Before run this code, please place all unprotected exce
files(workbooks) into a specific folder.
Hope this helps. :D


Code
-------------------

'Place these procedure in the STANDARD MODULE
Option Explicit

'Change here to your Password
Const vntPassWord As Variant = "wow g8"

Sub PerformProtectUnprotect()
Dim lngRet As Long
Dim strFolderName As String
Dim strFileName As String

'Ask what would you like to do. (Protect or Unprotect)
lngRet = MsgBox("If you want to Protect wkbs then click [YES]" & vbLf & vbLf & _
"Unprotect wkbs then click[NO]", vbYesNo + vbQuestion)

'Select a folder that un protected excel workbooks has been saved.
strFolderName = GetFolderName
If strFolderName = vbNullString Then Exit Sub

'Loop all excel workbooks in the selected folder
strFileName = Dir(strFolderName, vbNormal)
Application.ScreenUpdating = False
Do While strFileName < ""
'Protect/Unprotect
ControlProtection strFolderName & strFileName, lngRet = vbYes
strFileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "...Done"
End Sub

Private Sub ControlProtection(ByVal strWbPath As String, _
ByVal blnProtect As Boolean)
'blnProtect = True then Workbooks and Worksheets would be Protected.
'blnProtect = False then Workbooks and Worksheets would be Unprotected.

Dim wb As Workbook
Dim sh As Worksheet

'Open wkb
Set wb = Workbooks.Open(strWbPath)

For Each sh In wb.Worksheets
'Protect / Unprotect Worksheet
'Regarding to each arguments for protecting,
'please read help file and chenge them as you like.
If blnProtect Then
sh.Protect vntPassWord, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
Else
sh.Unprotect vntPassWord
End If
Next

'Protect / Unprotect Workbook
If blnProtect Then
wb.Protect vntPassWord, _
Structu=True
Else
wb.Unprotect vntPassWord
End If

'Save and Close wkb
Application.DisplayAlerts = False
wb.Close True
Application.DisplayAlerts = True
'Clear memory
Set wb = Nothing
End Sub

Private Function GetFolderName() As String
'A function for returns slected folder path
Dim objShApp As Object
Set objShApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Pls Selct Folder", 0, "c:\\")
If objShApp Is Nothing Then
GetFolderName = vbNullString
Else
GetFolderName = objShApp.self.Path
If Right(GetFolderName, 1) < Application.PathSeparator Then _
GetFolderName = GetFolderName & Application.PathSeparator
End If
End Function

-------------------


--
Message posted from http://www.ExcelForum.com