Avatar of stephenlecomptejr
stephenlecomptejr
Flag for United States of America asked on

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

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

VB ScriptMicrosoft AccessVBA

Avatar of undefined
Last Comment
stephenlecomptejr

8/22/2022 - Mon
Norie

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 Prew

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


»bp
ste5an

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.
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
ASKER CERTIFIED SOLUTION
Bill Prew

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
stephenlecomptejr

ASKER
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

SOLUTION
Bill Prew

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Gustav Brock

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.
stephenlecomptejr

ASKER
Appreciate the responses.
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
stephenlecomptejr

ASKER
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.