Excelファイルを開かずにパスワードロックを確認する方法

Sub ボタン1_Click() 
 Dim A As String
 Dim cnt As Long

 On Error Resume Next

 A = Dir("c:\Work\*.xlsx")
 Application.DisplayAlerts = False

 Do While A <> ""
  cnt = cnt + 1
  Cells(cnt, 1) = A
  SendKeys "{ESC}"
  Cells(cnt, 2) = "='c:\Work\[" & A & "]Sheet1'!A1"
  A = Dir()
 Loop
 
Application.DisplayAlerts = True

 With Range(Range("B1"), Range("B1").End(xlDown))
  .Value = .Value
 End With
End Sub

Option Compare Database
Option Explicit

Private Sub cmdCreateExcelFiles_Click()
     Dim DesktopPath As String, FilePath As String, WSH As Variant
    Set WSH = CreateObject("Wscript.Shell")
    DesktopPath = WSH.SpecialFolders("Desktop")
    'FilePath = DesktopPath & "\work" & "\CreatedByVBAFile.xlsx"

    Dim i As Long
    For i = 1 To 100
        FilePath = DesktopPath & "\work" & "\CreatedByVBAFile" & i & ".xlsx"
        Call CreateExcelFiles(FilePath)
    Next i
    Set WSH = Nothing
End Sub

Private Sub cmdCheckPass_Click()

    Dim ExApp As Object
    Set ExApp = CreateObject("Excel.Application")
    ExApp.Visible = True
    Dim DesktopPath As String, FilePath As String, WSH As Variant
    Set WSH = CreateObject("Wscript.Shell")
    DesktopPath = WSH.SpecialFolders("Desktop")
    FilePath = DesktopPath & "\createdExcel.xlsx"

    ExApp.Workbooks.Add

    Dim A As String
    Dim cnt As Long

    On Error Resume Next

    A = Dir("C:\Users\ユーザー名\Desktop\work\*.xlsx")
    ExApp.DisplayAlerts = False
    Do While A <> ""
        cnt = cnt + 1
        ExApp.Workbooks(ExApp.Workbooks.Count).Sheets(1).Cells(cnt, 1) = A

        ExApp.SendKeys "{ESC 3}"
        
        ExApp.Workbooks(ExApp.Workbooks.Count).Sheets(1).Cells(cnt, 2) = "='C:\Users\ユーザー名\Desktop\work\[" & A & "]Sheet1'!A1"
       
        If (IsError(ExApp.Workbooks(ExApp.Workbooks.Count).Sheets(1).Cells(cnt, 2))) Then
            ExApp.Workbooks(ExApp.Workbooks.Count).Sheets(1).Cells(cnt, 3) = "Locked"
        Else
            ExApp.Workbooks(ExApp.Workbooks.Count).Sheets(1).Cells(cnt, 3) = "---"
        End If
        
        A = Dir()
    Loop


'    With Range(Range("B1"), Range("B1").End(xlDown))
'        .Value = .Value
'    End With


    With ExApp.Workbooks(ExApp.Workbooks.Count)
        
        .SaveAs FileName:=FilePath
        .Close
    End With


    ExApp.Quit

    Set ExApp = Nothing
    Set WSH = Nothing

End Sub



Private Sub CreateExcelFiles(getFileName As String)
    Dim ExApp As Object
    Set ExApp = CreateObject("Excel.Application")
    ExApp.Visible = False
    Dim DesktopPath As String, FilePath As String, WSH As Variant
    Set WSH = CreateObject("Wscript.Shell")
    DesktopPath = WSH.SpecialFolders("Desktop")
    FilePath = getFileName

    ExApp.Workbooks.Add
    With ExApp.Workbooks(ExApp.Workbooks.Count)
        .Sheets(1).Cells(1, 1) = Now()
        .SaveAs FileName:=FilePath
        .Close
    End With
    ExApp.Quit

    Set ExApp = Nothing
    Set WSH = Nothing
End Sub