troubleshooting Question

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

Avatar of stephenlecomptejr
stephenlecomptejrFlag for United States of America asked on
VB ScriptMicrosoft AccessVBA
9 Comments2 Solutions122 ViewsLast Modified:
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
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 2 Answers and 9 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 2 Answers and 9 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros