We help IT Professionals succeed at work.

Need help with VBS Script that allows you to overcome Microsoft Access security pop-ups.

114 Views
Last Modified: 2019-01-23
Need help with overcoming Microsoft Access pop-up security messages.  My intention is run the following .vbs script below.  It already works within Microsoft Access - but I need it to work as a .vbs script to run before.  Thus when I convert it over to VBS one of the issues I face is it's GoTo statements it uses to overcome error messages.  

Obviously when I run it I get a syntax error on line 21 where there happens to be the first GoTo statement:

How would you rewrite the following below to overcome such?  If I have someone do one - then I could do the rest but was hoping for a rewrite of some of the statements to get me going?   Much appreciation for any comments.

Call AddTrustedLocation("C:\Apps\ETS")
Call AddTrustedLocation("\\americas.shell.com\americas\E & P\SEPCO Woodcreek\PROJ_07\Onshore Asset\ETS & MAPPING\Project Tracking")

WScript.Quit

Private Function AddTrustedLocation(strPath)

 Dim intLocns
 Dim i
 Dim intNotUsed
 Dim strLnKey
 Dim reg
 Dim strTitle

 strTitle = "Add Trusted Location"
 Set reg = CreateObject("wscript.shell")
 'Specify the registry trusted locations path for the version of Access used
 strLnKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Format(Application.Version, "##,##0.0") & "\Access\Security\Trusted Locations\Location"
 On Error GoTo err_proc0
   'find top of range of trusted locations references in registry
   For i = 999 To 0 Step -1
       reg.RegRead strLnKey & i & "\Path"
       GoTo chckRegPths        'Reg.RegRead successful, location exists > check for path in all locations 0 - i.
checknext:
   Next
   GoTo exit_proc
chckRegPths:
 'Check if Currentdb path already a trusted location 'reg.RegRead fails before intlocns = i then the registry location is unused and 'will be used for new trusted location if path not already in registy
 On Error GoTo err_proc1:
   For intLocns = 1 To i
       reg.RegRead strLnKey & intLocns & "\Path"
       'If Path already in registry -> exit
       If InStr(1, reg.RegRead(strLnKey & intLocns & "\Path"), strPath) = 1 Then GoTo exit_proc
NextLocn:
   Next
   If intLocns = 999 Then
       MsgBox "Location count exceeded - unable to write trusted location to registry", vbInformation, strTitle
       GoTo exit_proc
   End If
   'if no unused location found then set new location for path
   If intNotUsed = 0 Then intNotUsed = i + 1

 'Write Trusted Location regstry key to unused location in registry
 On Error GoTo err_proc:
   strLnKey = strLnKey & intNotUsed & "\"
   reg.RegWrite strLnKey & "AllowSubfolders", 1, "REG_DWORD"
   reg.RegWrite strLnKey & "Date", Now(), "REG_SZ"
   reg.RegWrite strLnKey & "Description", Application.CurrentProject.Name, "REG_SZ"
   reg.RegWrite strLnKey & "Path", strPath & "\", "REG_SZ"
exit_proc:
   Set reg = Nothing
   Exit Function
err_proc0:
   Resume checknext
err_proc1:
   If intNotUsed = 0 Then intNotUsed = intLocns
   Resume NextLocn
err_proc:
   Resume exit_proc
 End Function

Open in new window

Comment
Watch Question

NorieAnalyst Assistant
CERTIFIED EXPERT

Commented:
Are you sure the issue is security?

If it was I would have thought that the code wouldn't run at all rather than run until it met a certain piece of code.

What's the error/security message you are getting?

By the way, I'm not sure but I've a feeling that you can't use GoTo statements in VBS.

If that is the case you'll need to restructure the code to not use Goto, which is something I would recommend you do anyway.
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
Correct on GOTO, not supported in VBS (VB Script).


ยปbp
ste5anSenior Developer
CERTIFIED EXPERT

Commented:
Well, even in larger environments I had no problems with setting it hard-coded in a batch:

	Reg Add "HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations\LocationXX" /V "Path" /T reg_sz /D "YOUR-FOLDER-PATH-HERE" /F
	Reg Add "HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations\LocationXX" /V "AllowSubfolders" /T reg_dword /D "00000001" /F
	Reg Add "HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations\LocationXX" /V "Description" /T reg_sz /D "YOUR-APPLICATION-NAME-HERE" /F

Open in new window


Just use some high numbers for XX.
Test your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION

Author

Commented:
Hey Bill, got a lot of the errors out the way... except for just one:

At line 18: I'm going to have to figure out how to find the right Microsoft version of Access instead of just using Application.Version since it was originally in the MS Access VBA environment.

Call AddTrustedLocation("C:\Apps\ETS")
Call AddTrustedLocation("\\americas.shell.com\americas\E & P\SEPCO Woodcreek\PROJ_07\Onshore Asset\ETS & MAPPING\Project Tracking")

WScript.Quit

Private Function AddTrustedLocation(strPath)

 Dim intLocns
 Dim i
 Dim intNotUsed
 Dim strLnKey
 Dim reg
 Dim strTitle

 strTitle = "Add Trusted Location"
 Set reg = CreateObject("wscript.shell")
 'Specify the registry trusted locations path for the version of Access used
 strLnKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Format(Application.Version, "##,##0.0") & "\Access\Security\Trusted Locations\Location"
 On Error GoTo err_proc0
   'find top of range of trusted locations references in registry
   For i = 999 To 0 Step -1
       reg.RegRead strLnKey & i & "\Path"
       GoTo chckRegPths        'Reg.RegRead successful, location exists > check for path in all locations 0 - i.
checknext:
   Next
   GoTo exit_proc
chckRegPths:
 'Check if Currentdb path already a trusted location 'reg.RegRead fails before intlocns = i then the registry location is unused and 'will be used for new trusted location if path not already in registy
 On Error GoTo err_proc1:
   For intLocns = 1 To i
       reg.RegRead strLnKey & intLocns & "\Path"
       'If Path already in registry -> exit
       If InStr(1, reg.RegRead(strLnKey & intLocns & "\Path"), strPath) = 1 Then GoTo exit_proc
NextLocn:
   Next
   If intLocns = 999 Then
       MsgBox "Location count exceeded - unable to write trusted location to registry", vbInformation, strTitle
       GoTo exit_proc
   End If
   'if no unused location found then set new location for path
   If intNotUsed = 0 Then intNotUsed = i + 1

 'Write Trusted Location regstry key to unused location in registry
 On Error GoTo err_proc:
   strLnKey = strLnKey & intNotUsed & "\"
   reg.RegWrite strLnKey & "AllowSubfolders", 1, "REG_DWORD"
   reg.RegWrite strLnKey & "Date", Now(), "REG_SZ"
   reg.RegWrite strLnKey & "Description", Application.CurrentProject.Name, "REG_SZ"
   reg.RegWrite strLnKey & "Path", strPath & "\", "REG_SZ"
exit_proc:
   Set reg = Nothing
   Exit Function
err_proc0:
   Resume checknext
err_proc1:
   If intNotUsed = 0 Then intNotUsed = intLocns
   Resume NextLocn
err_proc:
   Resume exit_proc
 End Function

Open in new window

Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION
CERTIFIED EXPERT
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
You can use the script I published in my recent article:

Deploy and update a Microsoft Access application with one click

It takes care of the full process.

Author

Commented:
Appreciate the responses.

Author

Commented:
Sorry I just missed your responses, Gustav.  I have some further questions regarding your topic of Access distribution - but fear this may not be the best place for it.  I will try to send you a dm.

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions