Excelファイルを開かずにパスワード有無を確認するには・・・

Excelでセルに=[Bファイル]Sheet1!$A$1
と書いてExcelファイルを開かずに他のファイルのセル値を取得することができますよね？
それをexcelVBAで下の様に書くと、パスワードがかかったファイルは＃Ref!になって検出できます。

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

Access VBA バージョン

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