I have an Excel file with Excel file names in column A. I would like to run down column A and place in column B is that file is password protected.
Is this possible with VBA?
Check folder to check if Excel files is protected
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
-
- Administrator
- Posts: 78236
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Check folder to check if Excel files is protected
Does column A contain only file names, or the complete path + filename of the workbooks?
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Check folder to check if Excel files is protected
workbook name plus extension, but not the path. I would like to use the path of the active workbook.
-
- Administrator
- Posts: 78236
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Check folder to check if Excel files is protected
The following macro is inspired by VBA - Check if a workbook is protected before open it on StackOverflow. It should work for .xlsx, .xlsm and .xlsb workbooks, but not for .xls workbooks.
Code: Select all
Sub ListProtected()
Dim strPath As String
Dim sh As Object
Dim r As Long
Dim m As Long
Dim strWbk As String
Dim strZip As String
Dim p As Long
Dim nsp As Object
Application.ScreenUpdating = False
strPath = ThisWorkbook.Path
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Set sh = CreateObject("Shell.Application")
m = Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To m
strWbk = Range("A" & r).Value
p = InStrRev(strWbk, ".")
strZip = Left(strWbk, p) & "zip"
Name strPath & strWbk As strPath & strZip
Set nsp = sh.Namespace(strPath & strZip)
If nsp.Items.Count = 0 Then
Range("B" & r).Value = "Protected"
End If
Name strPath & strZip As strPath & strWbk
Next r
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Check folder to check if Excel files is protected
It doesn't seem to be working very well. It's only identifying .xls files, but these file are not even protected.
-
- Administrator
- Posts: 78236
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Check folder to check if Excel files is protected
This should be more dependable, but much slower:
Code: Select all
Sub ListProtected()
Dim strPath As String
Dim r As Long
Dim m As Long
Dim strWbk As String
Dim wbk As Workbook
Application.ScreenUpdating = False
strPath = ThisWorkbook.Path
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
On Error Resume Next
m = Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To m
strWbk = Range("A" & r).Value
Set wbk = Nothing
Set wbk = Workbooks.Open(Filename:=strPath & strWbk, Password:="")
If wbk Is Nothing Then
Range("B" & r).Value = "Protected"
Else
wbk.Close SaveChanges:=False
End If
Next r
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Check folder to check if Excel files is protected
Okay, maybe I'm confused here and simply confusing the issue. I suppose this code is checking to see if the workbook is protected, but I'm looking to see if any worksheet has a password. Most of the time the workbook will not be protected, but the worksheet or worksheets will.
-
- Administrator
- Posts: 78236
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Check folder to check if Excel files is protected
That was not what you asked in your first post, hence the macro does not do what you want!
Stay tuned.
Stay tuned.
Best wishes,
Hans
Hans
-
- Administrator
- Posts: 78236
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Check folder to check if Excel files is protected
Try this:
Code: Select all
Sub ListProtected()
Dim wsh As Worksheet
Dim strPath As String
Dim r As Long
Dim m As Long
Dim strWbk As String
Dim wbk As Workbook
Dim sh As Object
Application.ScreenUpdating = False
Set wsh = ActiveSheet
strPath = ThisWorkbook.Path
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
m = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row
For r = 2 To m
strWbk = Range("A" & r).Value
Set wbk = Nothing
On Error Resume Next
Set wbk = Workbooks.Open(Filename:=strPath & strWbk, Password:="")
If wbk Is Nothing Then
wsh.Range("B" & r).Value = "Workbook is protected"
Else
For Each sh In wbk.Sheets
If sh.ProtectContents Then
wsh.Range("B" & r).Value = "Workbook has at least one protected sheet"
Exit For
End If
Next sh
wbk.Close SaveChanges:=False
End If
Next r
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Check folder to check if Excel files is protected
Sorry about the poor explanation. This seems to do the trick.