Excel VBA Password Protection check [duplicate]


I have a project in which I have to go over 1,000+ excel files in a folder, and see which ones are password protected and which ones aren't. In order to save time, i wrote a macro to do this, which is as follows:

    Sub CheckWbook()
     Dim Value As String, a As Single,  myfolder as string
     With Application.FileDialog(msoFileDialogFolderPicker)
        myfolder = .SelectedItems(1) & "\"
     End With
     Range("C4") = myfolder
     Range("B7:C" & Rows.Count) = ""
     a = 0
     Value = Dir(myfolder)
     Do Until Value = ""
        If Value = "." Or Value = ".." Then
            If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
                On Error Resume Next
                Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz"
                If Err.Number > 0 Then
                    Range("C7").Offset(a, 0).Value = "Yes"
                End If
                Workbooks(Value).Close False
                On Error GoTo 0
                Range("B7").Offset(a, 0).Value = Value
                a = a + 1
             End If
End If
Value = Dir
End Sub

The problem I'm having is that the popup for the password is still present: it does not fill in the password. Any help would be highly appreciated. -A

Edit Changed the code a bit, and got past the error message, but now I'm getting stuck at the password popup, that stops the macro from completely working, despite the On Error Resume Next feature.

Then, i came across this code that i thought could help:

    Option Explicit

Public Sub ProcessBatch()

Dim strFileName As String
Dim strFilePath As String
Dim oDoc As Document

' Set Directory for Batch Process
strFilePath = "C:\Test\"

' Get Name of First .doc File from Directory
strFileName = Dir$(strFilePath & "*.doc")

While Len(strFileName) <> 0

    ' Set Error Handler
    On Error Resume Next

    ' Attempt to Open the Document
    Set oDoc = Documents.Open( _
               FileName:=strFilePath & strFileName, _
               PasswordDocument:="?#[email protected]$")

    Select Case Err.Number
        Case 0
            ' Document was Successfully Opened
            Debug.Print strFileName & " was processed."

        Case 5408
            ' Document is Password-protected and was NOT Opened
            Debug.Print strFileName & " is password-protected " & _
                "and was NOT processed."
            ' Clear Error Object and Disable Error Handler
            On Error GoTo 0
            ' Get Next Document
            GoTo GetNextDoc

        Case Else
            ' Another Error Occurred
            MsgBox Err.Number & ":" & Err.Description
    End Select

    ' Disable Error Handler
    On Error GoTo 0

    '---Perform Action on Document Here---

    ' Close Document

    ' Clear Object Variable
    Set oDoc = Nothing


    ' Get Next Document from Specified Directory
    strFileName = Dir$()


End Sub

but this fails to recognize the oDoc as a Document. Any ideas on how to get it working?


to open the excel file? or sheet

if it is a sheet should be

ActiveSheet.Unprotect Password: = "yourpassword"

if it is an excel


I hope it serves you a hug I learned a lot here I hope you will also hopefully serve my help

By : ReDStOrM

This video can help you solving your question :)
By: admin