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

Glory

Glory

Well-known Member
Joined
Mar 16, 2011
Messages
640
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.
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Sort by date Sort by votes
Code: 
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.
 
Upvote 0
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.
PHP: 
    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
 
Upvote 0
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 (?):

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

...In place of a wait time.

Code: 
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.
 
Last edited:
Upvote 0
Code: 
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.
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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:

Code: 
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:

Code: 
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.
 
Last edited:
Upvote 0
Why not try an Iif statement?
Code: 
<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>
 
Upvote 0
I think I did that backwards. I usually have to write them twice before I get them right.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Colleagues can't use my macro enabled workbook
Replies
8
Views
595
MARK858
MARK858
G
  • Solved
VBA Ref: Is there a way to check if "Trust access to VBA project object model" option is checked using VBA?
Replies
2
Views
706
gifariz
G
T
  • Solved
Move cursor to a specific cell after data has been entered
Replies
4
Views
352
Peter_SSs
Peter_SSs
P
  • Question Question
Excel/365 VBA crash issues recently
Replies
0
Views
511
picklefactory
P
M
  • Question Question
Excel Time Keeping "Application"
Replies
0
Views
556
Mrock1
M

Forum statistics

Threads
1,224,560
Messages
6,179,519
Members
452,921
Latest member
BBQKING

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top