how to find passworded files RRS feed

  • Question

  • A former employee password protected a file. In this case Excel, and the whole file, not just a sheet. I'd like to use a batch file to run through all the Office docs, make a call to open each, then some call to close it (so I don't have a ton of files open) and check the error code to see if it opened or not, assuming those that need a pwd will return an error. So that I can find any other files that have been locked, make a list, and verify we can get in them. Or maybe there's a util, or a macro script way to accomplish the same thing? Or some hidden attribute that says if a file is locked? I've hunted for a util but get tons of search results about passwords on files but not how to find which have them at all. Thanks. Excel 2013/2016
    Thursday, May 9, 2019 12:06 AM

All replies

  • Hi,

    Based on your description, I'll move your question to the MSDN forum for Excel

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.


    Emi Zhang

    Please remember to mark the replies as answers if they helped. If you have feedback for TechNet Subscriber Support, contact

    Click here to learn more. Visit the dedicated forum to share, explore and talk to experts about Microsoft Office 2019.

    Friday, May 10, 2019 7:55 AM
  • Njem,
    re: find password protected files

    If a message box pops up, press the cancel button.

    Sub FindProblemFiles()
    'James Cone - Portland, Oregon USA - May 2019
     On Error GoTo CloseOut
     Dim objFSO    As Object
     Dim objFolder As Object
     Dim objFile   As Object
     Dim strPath   As String
     Dim strName   As String
     Dim vCopyTo   As Variant
     Dim blnTask   As Boolean
     Dim lngRow    As Long
     Dim WB        As Excel.Workbook

     If VBA.Val(Application.Version) >= 10 And VBA.Val(Application.Version) < 15 Then
       blnTask = Application.ShowWindowsInTaskbar
       Application.ShowWindowsInTaskbar = False
     End If
    'Can use worksheet position or worksheet name
     vCopyTo = 1
     ThisWorkbook.Worksheets(vCopyTo).Range("A1:D1").Value = _
       Array("Folder", "File Name", "Error Number", "Error Description")
     ThisWorkbook.Worksheets(vCopyTo).Range("A1:D1").Font.Bold = True

     strPath = "C:\Excel Files\Commercial Projects\Brie Larson"    '<<<<<

    'Use Microsoft Scripting runtime.
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set objFolder = objFSO.GetFolder(strPath)
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
    'Check type of file in the folder and open file.
     For Each objFile In objFolder.Files
     If objFile.Name Like "*.xls*" Then
        strName = objFile.Name
        Application.StatusBar = strName
        Set WB = Workbooks.Open(objFile)

        WB.Close savechanges:=False
      End If
     Next 'objFile

     If Err.Number <> 0 Then
        With ThisWorkbook.Worksheets(vCopyTo)
         lngRow = .UsedRange.Rows.Count + 1
         .Cells(lngRow, 1).Value = strPath
         .Cells(lngRow, 2).Value = strName
         .Cells(lngRow, 3).Value = Err.Number
         .Cells(lngRow, 4).Value = Err.Description
        End With
        Resume Next
        If blnTask Then Application.ShowWindowsInTaskbar = blnTask
        Application.StatusBar = False
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
        Set objFile = Nothing
        Set objFolder = Nothing
        Set objFSO = Nothing
        Set WB = Nothing
     End If
    End Sub

    Custom_Functions add-in (19 new functions with instructions)
    Download from MediaFire...

    Friday, May 10, 2019 11:16 PM