VBAプロジェクト オブジェクト モデルへのアクセスを信頼するが有効か確認したい。

作成したワークブックにマクロモジュールをコピーするツール作ったのだけど、ユーザーから動かないと報告あり、ツールの性質上「VBAプロジェクト オブジェクト モデルへのアクセスを信頼する」を有効にする必要がある。先方にメールで確認してもよくわかってない感じなので、機械的に確認できるように
マクロを作成。

レジストリキーに設定値があるようなのでWSHで値を取得して判定を行う。

Option Explicit

Function CheckVBAAccessTrustWSH() As Boolean
    Dim WSHShell As Object
    Dim officeVersion As String
    Dim regPath As String
    Dim regValue As Variant
    Dim versionParts As Variant
    Dim errMsg As String
    Dim errorNumber As Long
    Dim errorDescription As String
    
    
    On Error Resume Next
    
    
    ' WSH オブジェクトを作成
    Set WSHShell = CreateObject("WScript.Shell")
    
    
    ' 現在の Excel のバージョン番号を取得
    officeVersion = Application.Version
    
    
    ' バージョン番号の処理をSplit関数で安全に行う
    versionParts = Split(officeVersion, ".")
    If UBound(versionParts) >= 1 Then
        officeVersion = versionParts(0) & "." & versionParts(1)
    End If
    
    ' レジストリパスを構築
    regPath = "HKCU\Software\Microsoft\Office\" & officeVersion & "\Excel\Security\AccessVBOM"
    
    ' 値の読み取りを試行
    regValue = WSHShell.RegRead(regPath)
    
    ' エラーチェック
    If Err.Number <> 0 Then
        ' On Error GoTo 0でリセットする前にNumberとDescriptionを保存
        errorNumber = Err.Number
        errorDescription = Err.Description
        
        
        Set WSHShell = Nothing
        
        ' エラー処理をリセット
        On Error GoTo 0
        

        Err.Raise 32001, "CheckVBAAccessTrustWSH", _
            "設定の確認中にエラーが発生しました。レジストリキーが見つからないか、アクセスできません。" & _
            vbCrLf & "チェックしたパス: " & regPath & _
            vbCrLf & "元のエラー: " & errorNumber & " - " & errorDescription

        Exit Function
    End If
    
    ' 結果を確認
    If regValue = 1 Then
        CheckVBAAccessTrustWSH = True
    Else
        CheckVBAAccessTrustWSH = False
    End If
    
    ' クリーンアップ
    Set WSHShell = Nothing
    On Error GoTo 0
End Function

Public Sub Test_CheckVBAAccessTrustWSH()
    Dim flag As Boolean
    
    On Error GoTo ErrorHandler
    
    flag = CheckVBAAccessTrustWSH()
    
    If flag Then
        MsgBox "VBAプロジェクトオブジェクトモデルへのアクセスが有効", vbInformation, "確認"
    Else
        MsgBox "VBAプロジェクトオブジェクトモデルへのアクセスが無効", vbExclamation, "警告"
    End If
    
    Exit Sub
    
ErrorHandler:

    If Err.Number = 32001 Then
        MsgBox Err.Description, vbCritical, "レジストリアクセスエラー"
    Else
        MsgBox "予期しないエラーが発生しました：" & Err.Description & " (エラー番号: " & Err.Number & ")", vbCritical, "エラー"
    End If
    
    Resume Exit_Test
    
Exit_Test:

    ' 終了処理
End Sub