[AccessD] Deployment Advice

In this case doing it via the GUI is not an option anyway, Mark, because 
this is not exposed via the Runtime.

Regards
Steve

-----Original Message----- 
From: Mark Simms
Sent: Monday, September 23, 2013 5:40 AM
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] Deployment Advice

Important to Remember:
this is a catch-22 situation....as you must close the application and reopen
it after making those API calls.
Been there, done that.
It does work however and it is a good option if you don't trust your users
can do it correctly via GUI.

> Function Startup()
> AddTrustedLocation
> DoCmd.Quit
> End Function
>
> Public Function AddTrustedLocation()
> On Error GoTo err_proc
> 'WARNING:  THIS CODE MODIFIES THE REGISTRY
> 'sets registry key for 'trusted location'
>
>   Dim intLocns As Integer
>   Dim i As Integer
>   Dim intNotUsed As Integer
>   Dim strLnKey As String
>   Dim reg As Object
>   Dim strPath As String
>   Dim strTitle As String
>   Dim strTrustedLocations As String
>   strTitle = "Add Trusted Location"
>   Set reg = CreateObject("wscript.shell")
>   strPath = CurrentProject.Path
>   strTrustedLocations = "HKEY_CURRENT_USER\Software\Microsoft\Office\"
> &
> Format(Application.Version, "##,##0.0") & _
>              "\Access\Security\Trusted Locations"
>   'Specify the registry trusted locations path for the version of
> Access used
>   strLnKey = strTrustedLocations & "\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
>   MsgBox "Unexpected Error - No Registry Locations found",
> vbExclamation
>   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:
> 'Allow Network Locations
>  reg.RegWrite strTrustedLocations & "\AllowNetworkLocations", 1,
> "REG_DWORD"
>
>  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 MsgBox
> CurrentProject.Path & " already in trusted locations": 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
>
> 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"
>   MsgBox CurrentProject.Path & " added to trusted locations"
> exit_proc:
>   Set reg = Nothing
>   Exit Function
>
> err_proc0:
>   Resume checknext
>
> err_proc1:
>   If intNotUsed = 0 Then intNotUsed = intLocns
>   Resume NextLocn
>
> err_proc:
>   MsgBox Err.Description, , strTitle
>   Resume exit_proc
>
> End Function
>
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com


-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com