[AccessD] Deployment Advice

Wow, great point Steve....you've just given me another issue to handle for
the rollout.
I'll deploy this as a one-time CommandLine driven operation post
installation of the runtime package.

> -----Original Message-----
> From: accessd-bounces at databaseadvisors.com [mailto:accessd-
> bounces at databaseadvisors.com] On Behalf Of Steve Schapel
> Sent: Sunday, September 22, 2013 5:14 PM
> To: Access Developers discussion and problem solving
> Subject: Re: [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
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com