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

LVL 1
stephenlecomptejrAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant 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 PrewIT / Software Engineering ConsultantCommented:
Correct on GOTO, not supported in VBS (VB Script).


»bp
ste5anSenior DeveloperCommented:
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.
Active Protection takes the fight to cryptojacking

While there were several headline-grabbing ransomware attacks during in 2017, another big threat started appearing at the same time that didn’t get the same coverage – illicit cryptomining.

Bill PrewIT / Software Engineering ConsultantCommented:
Did this quick, so read it over carefully and look for typos etc, didn't test it here.  But it should give you some ideas.

Also note, I never trust a FOR loop variable (i  in your case) after the loop ends.  That's bad practice, some languages may let you get away with it, but in general it's best to assume the for loop variable is only in scope and valid inside the for loop itself.  So I save it's value inside the loop when I want to reference it again later.

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 i
    Dim strLnKey
    Dim reg
    Dim strTitle
    Dim TopTrusted

    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"

    'Set to resume on errors so we can check for errors in code
    On Error Resume Next

    'find top of range of trusted locations references in registry
    TopTrusted = 999
    For i = 999 To 0 Step -1
        reg.RegRead strLnKey & i & "\Path"
        If Err.Number = 0 Then
            TopTrusted = i
            Exit For
        End If
    Next i

    'Exit if it already full
    If TopTrusted = 999 Then
        MsgBox "Location count exceeded - unable to write trusted location to registry", vbInformation, strTitle
        Exit Function
    End If

    'Check if Currentdb path already a trusted location
    For i = 1 To TopTrusted
        strTemp = reg.RegRead strLnKey & i & "\Path"
        'If Path already in registry -> exit
        If InStr(1, strTemp, strPath) = 1 Then 
            Exit Function
        End If
    Next

    'Write Trusted Location regstry key to unused location in registry
    strLnKey = strLnKey & (TopTrusted+1) & "\"
    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"

    If Err.Number <> 0 Then
        MsgBox "Unable to add path to registy - " & strPath, vbInformation, strTitle
    End If

End Function

Open in new window


»bp

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
stephenlecomptejrAuthor 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 PrewIT / Software Engineering ConsultantCommented:
This seems to work (from first link), but 3 others in the (second link below, including one of the comments).


Dim oRegistry
Dim sKey
Dim sValue
Dim sAppVersion
Const HKEY_CLASSES_ROOT 	= &H80000000
 
Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/default:StdRegProv")
sKey = "Access.Application\CurVer"
oRegistry.GetStringValue HKEY_CLASSES_ROOT, sKey, "", sValue
sAppVersion = Right(sValue, Len(sValue) - InStrRev(sValue, "."))
MsgBox sAppVersion & ""
Set oRegistry = Nothing

Open in new window

Gustav BrockCIOCommented:
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.
stephenlecomptejrAuthor Commented:
Appreciate the responses.
stephenlecomptejrAuthor 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.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.