I was recently asked to provide an way to batch process a set of Microsoft Excel and Word documents to password protect them and managed to use VBA to accomplish this. Coding isn’t something I commonly perform so I thought I’d write this blog post for anyone who may be looking for something similar as well as have it for myself to reference in the future.
Using an Excel Spreadsheet with passwords to password protect Excel files
1. Begin by creating an Excel spreadsheet with two columns and fill in the Password column with as many rows of passwords as there are Excel files to encrypt:
2. Save the file at a location that is outside of the folder containing the Excel files to encrypt. We will use C:\temp for this example.
3. Launch Excel, click on the Developer tab and click on Visual Basic:
4. Click on the Insert tab and then Module:
5. Paste the following code into the module:
Sub ProtectMultiExcelWithOpenPasswordwithExcelReferenceFile()
Application.ScreenUpdating = False
'Disable privacy settings warning
Application.DisplayAlerts = False
Dim passwordListExcel As Workbook
Dim protectThisWorkbook As Workbook
Dim strPassword As String, strFile As String, strFolder, strDestFolder As String
Dim passwordRow As Integer
strFolder = "C:\Excel\"
strFile = Dir(strFolder & "*.xlsx", vbNormal)
strDestFolder = "C:\Excel\Encrypted\"
' OPEN THE EXCEL WORKBOOK WITH PASSWORDS
Set passwordListExcel = Workbooks.Open("C:\temp\ExcelFiles.xlsx")
'SET ROW TO START AT 2 IGNORING THE HEADER
passwordRow = 2
' BEGIN LOOPING THROUGH EXCEL WORKBOOK TO SET PASSWORDS
While strFile <> ""
Set protectThisWorkbook = Workbooks.Open(Filename:=strFolder & strFile)
strPassword = passwordListExcel.Worksheets("Sheet1").Range("B" & passwordRow).Formula
'OPEN EXCEL, SET PASSWORD, SAVE AND CLOSE
With protectThisWorkbook
.Password = strPassword
.SaveAs Filename:=strDestFolder & "Encrypted-" & strFile, Password:=strPassword
.Close
End With
' WRITE THE DOCUMENT NAME INTO THE CELL BESIDE THE PASSWORD IN THE REFERENCE SPREADSHEET
passwordListExcel.Worksheets("Sheet1").Range("A" & passwordRow).Formula = strFile
'INCREMENT THE ROW COUNT BY 1 TO GO TO THE NEXT ROW
passwordRow = passwordRow + 1
strFile = Dir()
Wend
passwordListExcel.Close True
Set passwordListExcel = Nothing
End Sub
6. Update the variables to desired values:
strFolder: Where the source files are (ensure that the trailing "\" is in the path)
strDestFolder: Where the destination password protected files should be
(ensure that the trailing "\" is in the path)
Set passwordListExcel = Workbooks.Open("C:\temp\ExcelFiles.xlsx"): Update the path to where the spreadsheet with the passwords is located as created in step #1.
7. Proceed to run the module by clicking on the play button or F5:
8. Reopening the reference Excel spreadsheet will now have the encrypted document name filled out:
9. Encrypted files should be present in the defined directory:
Generate random passwords to password protect Excel files
The following demonstrates how use VBA code to generate random passwords, encrypt Excel files in a specified folder, write the Excel file name and the respective password into an Excel spreadsheet.
1. Begin by creating an Excel spreadsheet with two columns with the heading Document Name and Password:
2. Save the file at a location that is outside of the folder containing the Excel files to encrypt. We will use C:\temp for this example.
3. Launch Excel, click on the Developer tab and click on Visual Basic:
4. Click on the Insert tab and then Module:
5. Paste the following code into the module:
Function RandomString(Length As Integer)
Dim CharacterBank As Variant
Dim x As Long
Dim str As String
'Test Length Input
If Length < 1 Then
MsgBox "Length variable must be greater than 0"
Exit Function
End If
CharacterBank = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", _
"k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", _
"y", "z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "!", "@", _
"#", "$", "%", "^", "&", "*", "A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", _
"W", "X", "Y", "Z")
'Randomly Select Characters One-by-One
For x = 1 To Length
Randomize
str = str & CharacterBank(Int((UBound(CharacterBank) - LBound(CharacterBank) + 1) * Rnd + LBound(CharacterBank)))
Next x
'Output Randomly Generated String
RandomString = str
End Function
Sub ProtectMultiExcelWithOpenPasswordwithExcelReferenceFile()
Application.ScreenUpdating = False
'Disable privacy settings warning
Application.DisplayAlerts = False
Dim passwordListExcel As Workbook
Dim protectThisWorkbook As Workbook
Dim strPassword As String, strFile As String, strFolder, strDestFolder As String
Dim passwordRow As Integer
Dim passwordLength As Integer
strFolder = "C:\Excel\"
strFile = Dir(strFolder & "*.xlsx", vbNormal)
strDestFolder = "C:\Excel\Encrypted\"
passwordLength = 14
' OPEN THE EXCEL WORKBOOK WITH PASSWORDS
Set passwordListExcel = Workbooks.Open("C:\temp\ExcelFiles.xlsx")
'SET ROW TO START AT 2 IGNORING THE HEADER
passwordRow = 2
' BEGIN LOOPING THROUGH EXCEL WORKBOOK TO SET PASSWORDS
While strFile <> ""
Set protectThisWorkbook = Workbooks.Open(Filename:=strFolder & strFile)
'GENERATE RANDOM PASSWORD WITH SPECIFIED LENGTH
strPassword = RandomString(passwordLength)
'OPEN EXCEL, SET PASSWORD, SAVE AND CLOSE
With protectThisWorkbook
.Password = strPassword
.SaveAs Filename:=strDestFolder & "Encrypted-" & strFile, Password:=strPassword
.Close
End With
' WRITE THE DOCUMENT NAME INTO THE CELL BESIDE THE PASSWORD IN THE REFERENCE SPREADSHEET
passwordListExcel.Worksheets("Sheet1").Range("A" & passwordRow).Formula = strFile
' WRITE THE PASSWORD INTO THE CELL IN THE REFERENCE SPREADSHEET
passwordListExcel.Worksheets("Sheet1").Range("B" & passwordRow).Formula = strPassword
'INCREMENT THE ROW COUNT BY 1 TO GO TO THE NEXT ROW
passwordRow = passwordRow + 1
strFile = Dir()
Wend
passwordListExcel.Close True
Set passwordListExcel = Nothing
End Sub
6. Update the variables to desired values:
strFolder: Where the source files are (ensure that the trailing "\" is in the path)
strDestFolder: Where the destination password protected files should be
(ensure that the trailing "\" is in the path)
Set passwordListExcel = Workbooks.Open("C:\temp\ExcelFiles.xlsx"): Update the path to where the spreadsheet with the passwords is located as created in step #1.
7. Proceed to run the module by clicking on the play button or F5:
8. Reopening the reference Excel spreadsheet will now have the encrypted document name and password filled out:
9. Encrypted files should be present in the defined directory:
Using an Excel Spreadsheet with passwords to password protect Word files
The following demonstrates how to use an Excel spreadsheet with passwords to password protect a folder with Word files.
1. Begin by creating an Excel spreadsheet with two columns and fill in the Password column with as many rows of passwords as there are Word files to encrypt:
2. Save the file at a location that is outside of the folder containing the Excel files to encrypt. We will use C:\temp for this example.
3. Launch Word, click on the Developer tab and click on Visual Basic:
4. Click on the Insert tab and then Module:
5. Paste the following code into the module:
Sub ProtectMultiDocWithOpenPasswordwithExcelReferenceFile()
Application.ScreenUpdating = False
'Disable privacy settings warning
Application.DisplayAlerts = False
Dim excelObject As Object
On Error Resume Next
Set excelObject = GetObject(, "Excel.Application")
If Err Then
Set excelObject = CreateObject("Excel.Application")
End If
On Error GoTo 0
Dim passwordListExcel
Dim protectThisDocument As Document
Dim strPassword As String, strFile As String, strFolder, strDestFolder As String
Dim passwordRow As Integer
strFolder = "C:\Word\"
strFile = Dir(strFolder & "*.docx", vbNormal)
strDestFolder = "C:\Word\Encrypted\"
' OPEN THE EXCEL WORKBOOK WITH PASSWORDS
Set passwordListExcel = excelObject.Workbooks.Open("C:\temp\WordFiles.xlsx")
'SET ROW TO START AT 2 IGNORING THE HEADER
passwordRow = 2
' BEGIN LOOPING THROUGH WORD WORKBOOK TO SET PASSWORDS
While strFile <> ""
Set protectThisDocument = Documents.Open(FileName:=strFolder & strFile)
strPassword = passwordListExcel.Worksheets("Sheet1").Range("B" & passwordRow).Formula
'OPEN WORD, SET PASSWORD, SAVE AND CLOSE
With protectThisDocument
.Password = strPassword
.SaveAs2 FileName:=strDestFolder & "Encrypted-" & strFile, Password:=strPassword
.Close
End With
' WRITE THE DOCUMENT NAME INTO THE CELL BESIDE THE PASSWORD IN THE REFERENCE SPREADSHEET
passwordListExcel.Worksheets("Sheet1").Range("A" & passwordRow).Formula = strFile
'INCREMENT THE ROW COUNT BY 1 TO GO TO THE NEXT ROW
passwordRow = passwordRow + 1
strFile = Dir()
Wend
passwordListExcel.Close True
Set passwordListExcel = Nothing
End Sub
6. Update the variables to desired values:
strFolder: Where the source files are (ensure that the trailing "\" is in the path)
strDestFolder: Where the destination password protected files should be
(ensure that the trailing "\" is in the path)
Set passwordListExcel = Workbooks.Open("C:\temp\WordFiles.xlsx"): Update the path to where the spreadsheet with the passwords is located as created in step #1.
7. Proceed to run the module by clicking on the play button or F5:
8. Reopening the reference Excel spreadsheet will now have the encrypted document name filled out:
9. Encrypted files should be present in the defined directory:
Generate random passwords to password protect Word files
The following demonstrates how use VBA code to generate random passwords, encrypt Word files in a specified folder, write the Word file name and the respective password into an Excel spreadsheet.
1. Begin by creating an Excel spreadsheet with two columns with the heading Document Name and Password:
2. Save the file at a location that is outside of the folder containing the Excel files to encrypt. We will use C:\temp for this example.
3. Launch Word, click on the Developer tab and click on Visual Basic:
4. Click on the Insert tab and then Module:
5. Paste the following code into the module:
Function RandomString(Length As Integer)
Dim CharacterBank As Variant
Dim x As Long
Dim str As String
'Test Length Input
If Length < 1 Then
MsgBox "Length variable must be greater than 0"
Exit Function
End If
CharacterBank = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", _
"k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", _
"y", "z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "!", "@", _
"#", "$", "%", "^", "&", "*", "A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", _
"W", "X", "Y", "Z")
'Randomly Select Characters One-by-One
For x = 1 To Length
Randomize
str = str & CharacterBank(Int((UBound(CharacterBank) - LBound(CharacterBank) + 1) * Rnd + LBound(CharacterBank)))
Next x
'Output Randomly Generated String
RandomString = str
End Function
Sub ProtectMultiDocWithOpenPasswordwithExcelReferenceFile()
Application.ScreenUpdating = False
'Disable privacy settings warning
Application.DisplayAlerts = False
Dim excelObject As Object
On Error Resume Next
Set excelObject = GetObject(, "Excel.Application")
If Err Then
Set excelObject = CreateObject("Excel.Application")
End If
On Error GoTo 0
Dim passwordListExcel
Dim protectThisDocument As Document
Dim strPassword As String, strFile As String, strFolder, strDestFolder As String
Dim passwordRow As Integer
Dim passwordLength As Integer
strFolder = "C:\Word\"
strFile = Dir(strFolder & "*.docx", vbNormal)
strDestFolder = "C:\Word\Encrypted\"
passwordLength = 14
' OPEN THE EXCEL WORKBOOK WITH PASSWORDS
Set passwordListExcel = excelObject.Workbooks.Open("C:\temp\WordFiles.xlsx")
'SET ROW TO START AT 2 IGNORING THE HEADER
passwordRow = 2
' BEGIN LOOPING THROUGH WORD WORKBOOK TO SET PASSWORDS
While strFile <> ""
Set protectThisDocument = Documents.Open(FileName:=strFolder & strFile)
'GENERATE RANDOM PASSWORD WITH SPECIFIED LENGTH
strPassword = RandomString(passwordLength)
'OPEN WORD, SET PASSWORD, SAVE AND CLOSE
With protectThisDocument
.Password = strPassword
.SaveAs2 FileName:=strDestFolder & "Encrypted-" & strFile, Password:=strPassword
.Close
End With
' WRITE THE DOCUMENT NAME INTO THE CELL BESIDE THE PASSWORD IN THE REFERENCE SPREADSHEET
passwordListExcel.Worksheets("Sheet1").Range("A" & passwordRow).Formula = strFile
' WRITE THE PASSWORD INTO THE CELL IN THE REFERENCE SPREADSHEET
passwordListExcel.Worksheets("Sheet1").Range("B" & passwordRow).Formula = strPassword
'INCREMENT THE ROW COUNT BY 1 TO GO TO THE NEXT ROW
passwordRow = passwordRow + 1
strFile = Dir()
Wend
passwordListExcel.Close True
Set passwordListExcel = Nothing
End Sub
6. Update the variables to desired values:
strFolder: Where the source files are (ensure that the trailing "\" is in the path)
strDestFolder: Where the destination password protected files should be
(ensure that the trailing "\" is in the path)
Set passwordListExcel = Workbooks.Open("C:\temp\WordFiles.xlsx"): Update the path to where the spreadsheet with the passwords is located as created in step #1.
7. Proceed to run the module by clicking on the play button or F5:
8. Reopening the reference Excel spreadsheet will now have the encrypted document name and password filled out:
9. Encrypted files should be present in the defined directory:
1 comment:
Dim protectThisDocument As Document - This is not being accepted when I am running the macro
Post a Comment