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

stephenlecomptejr
stephenlecomptejr used Ask the Experts™
on
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

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
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 Consultant
Top Expert 2016

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


»bp
ste5anSenior Developer

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.
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

IT / Software Engineering Consultant
Top Expert 2016
Commented:
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

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 PrewIT / Software Engineering Consultant
Top Expert 2016
Commented:
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

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.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial