Steve Erbach
erbachs at gmail.com
Wed Oct 22 07:23:17 CDT 2014
Stuart,
Actually, while I was Googling a resolution to this problem I ran across
somebody recommending that very same registry change...albeit doing it
manually rather than with a VB script.
All right, I think I'll go that route. Thank you very much.
Sincerely,
Steve Erbach
Neenah, WI
On Wed, Oct 22, 2014 at 7:05 AM, Stuart McLachlan <stuart at lexacorp.com.pg>
wrote:
> On 22 Oct 2014 at 6:27, Steve Erbach wrote:
>
> > If this were a full install of Access 2003 I would simply change the
> > macro security setting. But what, if anything, do I have to do to get
> > rid of this warning in Runtime?
> >
>
>
> I've got a little accd that I stick in the problem directory and open once
> to make it a trusted
> location. Works fine with just the Runtime installed.
>
> It consists of an Autoexec macro that runs the function "Startup".
>
> The file just contain one module (watch for wordwrap) - can't remembr
> whereI got the code
> from, but it works perfectly for me every time;
>
> Option Compare Database
> Option Explicit
>
> 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
>
> strTitle = "Add Trusted Location"
> Set reg = CreateObject("wscript.shell")
> strPath = CurrentProject.Path
>
> '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
> 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:
> 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
>
> '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"
> 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
>