シンプルにワークブックを開くための努力が詰まったVBAルーチン

Microsoft Excelのファイルを開く際、とにかく早く処理をしたくて余計な動作を全部省くことを考えました。
再計算はなし、リンクは開かない、マクロなんか実行するものか、書式設定？関係ないでしょ、でゴリゴリにやってみますとこんなルーチンになりました。

元々は「ブックがパスワード付きかどうか？」を判別するために作ったものなので「パスワードが設定されていれば開かないけど開けなかったという事象はわかる」程度には優秀（？）です。

限界はありまして、

1. ワークブックClose時のマクロ実行は止められない。
2. 壊れたワークブックを開こうとすると、呼び出したこのVBAも落ちる。

です。回避策があったら教えて下さい。
"ｆ"というファイルオブジェクトを入力としたサブルーチンです。

'引数はファイルオブジェクト"f"。
'つまり直接は出てこないけどもFilesystemObjectを使っているので
'参照設定 Microsoft Scripting Runtime が必要となります。

Sub execute(f As file)

'「パスワード付きファイルは開けない」でいいので適当
Const パスワード = " "

Dim 拡張子 as string
Dim ws As Worksheet

Dim flg_open As Boolean
Dim chkFn As Long

'実用上、あったほうがいいルーチンもおまけ。
’まずは一時ファイルを読み飛ばす
    If Left(f.Name, 2) = "~$" Then
        Exit Sub
    End If

' 拡張子を見てみる。
    拡張子 = Right(f.Name, Len(f.Name) - InStrRev(f.Name, "."))

'Microsoft Excelのファイルだったら開くけど、
'テンプレート開くとややこしいことになるのでスルー
    If Left(拡張子, 3) <> "xls" Then
        Exit Sub
    End If
'おまけはここまで

    'ワークブックを読み取り専用で開く
    'パスワード付ファイルは適当なパスワードで開いて開かなければ読み飛ばす
 
    'Application.ScreenUpdating = False
    'メッセージが出るのを抑止
    Application.DisplayAlerts = False
    'ワークブックオープン時の自動計算を止める
    Application.Calculation = xlCalculationManual
    'ワークブックオープン時のマクロ自動実行を止める。
    Application.EnableEvents = False
    
    On Error Resume Next 'これをいれないとパスワードが違うのメッセージが出る。
    '読み取り専用、リンクを更新しない、「読み取り専用で開きますか？」の確認を抑止
    Workbooks.Open Filename:=f.path, ReadOnly:=True, UpdateLinks:=0, _
                            IgnoreReadOnlyRecommended:=True, Password:="", WriteResPassword:=パスワード
    '
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    On Error GoTo 0
    DoEvents
    
    flg_open = True
    If ActiveWorkbook.Name <> f.Name Then
        Call ファイルが開けなかったときの処理(f.Name)
        flg_open = False
    Else
        Call ファイルが開けたときの処理(f.Name)
    End If

    'Saveするとき､ホントにセーブするか尋ねてくるのがうっとうしいので､確認画面を表示しない｡
    Application.DisplayAlerts = False
    DoEvents
    
    'ブックが開いていることを確認してからクローズする｡
    On Error Resume Next
    If Not flg_open Then
        chkFn = FreeFile
        On Error Resume Next
        Open f.path For Append As #chkFn
        Close #chkFn
    End If
    
    If Err.Number <= 0 Then
        Workbooks(f.Name).Close savechanges:=False
    End If
    On Error GoTo 0
    
    DoEvents

    Application.EnableEvents = True
    '確認画面を表示しない設定を続けると本当にエラーが出た時困るので戻す。
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

呼び出し方はこんなかんじ。
定数Pathで指定したフォルダに有るファイル（の中のMicrosoftExcelブック）を順次開いて処理する。

Sub main()

Const Path = "D:\"

Dim fso As FileSystemObject: Set fso = New FileSystemObject
Dim objFile As file
        
    ' GetFolder(フォルダ名).Filesでフォルダ配下のファイル一覧を取得
    For Each objFile In fso.GetFolder(Path).Files
        Call execute(objFile)
        DoEvents
    Next

End Sub