Is there a way to programatically check the 'Trust Access To VB Project' setting?

[Glory]

Same as title. I need to have it enabled, and I'd like the macro I'm running to popup with a messagebox if it's not.

 

[Glory]

Public Sub test99()
 
On Error GoTo Catch
 
a1 = ThisWorkbook.VBProject.VBComponents.Count
 
Exit Sub
 
Catch:
 
If Not Err.Number = 1004 Then Exit Sub
 
 
a2 = MsgBox("A macro failure has occurred." & Chr(10) & Chr(10) & _
     "Visual Basic Project ""Trust"" may be disabled." & Chr(10) & _
     "To enable this setting:" & Chr(10) & Chr(10) & _
     "1) Click " & Chr(145) & "Tools-> Macro-> Security" & Chr(146) & Chr(10) & _
     "2) Click Trusted Publishers" & Chr(10) & _
     "3) Check Trust Access to Visual Basic Project", vbOKOnly, "Runtime Error 1004")
 
End Sub

Succeeds with a simple error handler. Error number is: 1004, which is pretty generic unfortunately. But this turns the trick.

 

[MPW]

I have just been working with this to try to 'patch' outdated code.
SendKeys works pretty good. This will check it then uncheck it when you done (if you want).
Adding the wait helps on some machines to slow it down before running your code. You might not need it.

    If VBAIsTrusted = False Then
        Call SendKeys("%TM{DOWN}{DOWN}{ENTER}T%V{ENTER}")
        DoEvents
        Application.Wait Now + TimeValue("00:00:05")
    End If

    'Put your code here.
           
    If VBAIsTrusted = True Then
        Call SendKeys("%TM{DOWN}{DOWN}{ENTER}T%V{ENTER}")
        DoEvents
        Application.Wait Now + TimeValue("00:00:05")
    End If

 

[Glory]

I wouldn't have even thought about using SendKeys to do that, I've had such issues trying to use it in the past.

Your code works with as little as two seconds of wait time on this machine... or you might be able to try something similar to (?):

Do: ThisWorkbook.VBProject.VBComponents.Count: Resume: _
Loop While Err.Number <> 0

...In place of a wait time.

Private Function VBAIsTrusted()  As Boolean
On Error GoTo Label1
a1 = ThisWorkbook.VBProject.VBComponents.Count
VBAIsTrusted = True
Label1:
VBAIsTrusted = False
End Function
 
 
 
Public Sub CheckTrust()
On Error Resume Next
    If VBAIsTrusted = False Then
        Call SendKeys("%TM{DOWN}{DOWN}{ENTER}T%V{ENTER}")
        DoEvents
        Do: Resume: ThisWorkbook.VBProject.VBComponents.Count: _
        Loop While Err.Number <> 0
    End If
MsgBox ThisWorkbook.VBProject.VBComponents.Count
 
    If VBAIsTrusted = True Then
        Call SendKeys("%TM{DOWN}{DOWN}{ENTER}T%V{ENTER}")
        DoEvents
        Do: Resume: ThisWorkbook.VBProject.VBComponents.Count: _
        Loop While Err.Number <> 0
    End If
End Sub

Untested.

 

[Glory]

Private Function VBAIsTrusted() As Boolean
 
    On Error GoTo Label1
 
    a1 = ThisWorkbook.VBProject.VBComponents.Count
 
    VBAIsTrusted = True
 
Label1:
 
    VBAIsTrusted = False
 
End Function
 
Public Sub CheckTrust()
 
    On Error Resume Next
 
    If VBAIsTrusted = False Then

        Call SendKeys("%TM{DOWN}{DOWN}{ENTER}T%V{ENTER}")
 
        Do
            b1 = ThisWorkbook.VBProject.VBComponents.Count
            DoEvents
        Loop While IsEmpty(b1)
 
    End If
 
MsgBox ThisWorkbook.VBProject.VBComponents.Count
           
    If VBAIsTrusted = True Then

        Call SendKeys("%TM{DOWN}{DOWN}{ENTER}T%V{ENTER}")

        Do
            b1 = ThisWorkbook.VBProject.VBComponents.Count
            DoEvents
        Loop While Not IsEmpty(b1)
 
    End If
 
End Sub

First half works great. Doesn't re-disable trust access yet though.

 

[MPW]

Maybe a loop to check if the VBAIsTrusted = False might be the way to go.
One thing I did forget to mention. . .
I had to run this from a button on the worksheet, not from a module, because of the nature of sendkeys working on the focused window.

 

[Glory]

Yeah, I've been running it from the macro menu.

Looping the function doesn't work either... I wonder why? Can't really step through to check, seeing how that kills the point.

 

[Glory]

A break point at the last end if and a check through the immediate window shows b1 remains equal to the quantity of modules in the code... even when that last loop is set like this:

Loop Until IsEmpty(b1)

How can the second loop terminate if b1 remains initialized the entire time? I get that it might retain the value because of the error that occurs when trust is finally disabled... but I don't get how the loop ends if the variable is not empty.

Ran this just to be absolutely sure I wasn't spacing on the way it works:

Do
i = i + 1
Loop Until i = 10
MsgBox i

Reveals i = 10, which means the loop is not running one last time when the 'Until' condition is finally met... which was what I thought the problem might be.

 

[MPW]

Why not try an Iif statement?

<code>[COLOR=#000000]MsgBox IIf[/COLOR][COLOR=#000000]([/COLOR]</code>VBAIsTrusted = False<code>[COLOR=#990000][/COLOR][COLOR=#000000], [/COLOR][COLOR=#2a00ff]"UnLocked"[/COLOR][COLOR=#000000], [/COLOR][COLOR=#2a00ff]"Locked"[/COLOR][COLOR=#000000])[/COLOR]</code>

 

[MPW]

I think I did that backwards. I usually have to write them twice before I get them right.