[AccessD] Error 3027 in A2003 runtime

 That's the best way to handle it.

Jim. 

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Steve Erbach
Sent: Wednesday, October 22, 2014 08:23 AM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Error 3027 in A2003 runtime

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
>
-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com