8- Zona de Confianza

Autor Javier Gómez (javier.mil)

Para evitar los molestos mensajes de seguridad, es necesario crea un Zona de Confianza en Access. Los dos códigos expuesto sirven tanto para Access 2007 como Access 2010.

La primera vez saldría el mensaje de advertencia, pero No en la siguientes veces. Si quieres también evitar que salga desde el primer momento que lanzas el programa deberías mirar esta demo Ver demo 46

1- Zona de confianza utilizando LOCATION (n)
2- Zona de confianza sin utilizar LOCATION (n)

1- Zona de confianza utilizando LOCATION (n)

Para evitar los molestos mensajes de seguridad, es necesario crea un Zona de confianza en Access. El codigo expuesto sirve tanto para Access 2007 como Access 2010 y utiliza la clave "Location" que es la clave que por defecto que utiliza Access. Poner el siguiente codigo en un Modulo standard

Option Explicit

Const cPrefijo As String = "HKEY_CURRENT_USER\Software\Microsoft\Office\"
Const cSufijo As String = "\Access\Security\Trusted Locations\Location"

Public Function funTest ()

      If funCrearZonaConfianza = True Then
            MsgBox "Ok se ha creado una nueva zona de confianza", vbInformation, "Zona de Confianza"
      Else
            MsgBox "No es necesario crear la zona de confianza", vbExclamation, "Zona de Confianza"
      End If

End Function

Public Function funCrearZonaConfianza () As Boolean
'---------------------------------------------------------------------------------------

' Procedure : funCrearZonaConfianza

' DateTime : 23/01/2010 20:34

' Author : Javier Gomez ("Javier.Mil")

' WEB : www.accessdemo.info

' Purpose : Crea Zona de Confianza para Access 2007 y Access 2010 utilizando "LOCATION (n)"

'---------------------------------------------------------------------------------------
On Error GoTo Err_Local

      Dim objWshShell As Object
      Dim intX As Integer
      Dim strVersion As String

Set objWshShell = CreateObject("Wscript.Shell")

strVersion = SysCmd(acSysCmdAccessVer)

If strVersion = "12.0" Or strVersion = "14.0" Then
If funBuscarZonaConfianza <> CurrentProject.Path & "\" Then

intX = funPrimerLocationVacio

objWshShell.RegWrite cPrefijo & strVersion & cSufijo & intX & "\AllowNetworkLocations", 1, "REG_DWORD"
objWshShell.RegWrite cPrefijo & strVersion & cSufijo & intX & "\AllowSubfolders", 1, "REG_DWORD"

                  objWshShell.RegWrite cPrefijo & strVersion & cSufijo & intX & "\Date", Format(Now(), "mm/dd/yyyy hh:mm")
                  objWshShell.RegWrite cPrefijo & strVersion & cSufijo & intX & "\Description", "Mi nueva zona de confianza"
                  objWshShell.RegWrite cPrefijo & strVersion & cSufijo & intX & "\Path", CurrentProject.Path & "\"

funCrearZonaConfianza = True

Else
funCrearZonaConfianza = False

End If
End If

Close_Local:
Set objWshShell = Nothing

Exit_Local:
Exit Function

Err_Local:
      funCrearZonaConfianza = False
      MsgBox err.Description, vbCritical, "Error N°: " & err.Number
      Resume Exit_Local:
End Function

Private Function funBuscarZonaConfianza () As String
'---------------------------------------------------------------------------------------
' Procedure : funBuscarZonaConfianza
' DateTime : 23/01/2010 20:34
' Author     : Javier Gomez ("Javier.Mil")
' WEB       : www.accessdemo.info
' Purpose   : Busca si existe la Zona de Confianza
'---------------------------------------------------------------------------------------

On Error Resume Next

      Dim objWshShell As Object
      Dim strTemp As String
      Dim intX As Integer
      Dim strVersion As String

Set objWshShell = CreateObject("Wscript.Shell")
strVersion = SysCmd(acSysCmdAccessVer)

For intX = 0 To 99
strTemp = objWshShell.RegRead(cPrefijo & strVersion & cSufijo & intX & "\Path")

            If strTemp = CurrentProject.Path & "\" Then
                  funBuscarZonaConfianza = strTemp
                  Exit For
            End If
      Next intX

Set objWshShell = Nothing

End Function

Private Function funPrimerLocationVacio () As Integer
'---------------------------------------------------------------------------------------
' Procedure : funPrimerLocationVacio
' DateTime : 31/01/2010
' Author : Javier Gomez ("Javier.Mil")
' WEB : www.accessdemo.info
' Purpose :Busca el primer Location vacio o libre
'---------------------------------------------------------------------------------------

On Error Resume Next

    Dim objWshShell As Object
    Dim strTemp As String
    Dim intX As Integer
    Dim strVersion As String

Set objWshShell = CreateObject("Wscript.Shell")
strVersion = SysCmd(acSysCmdAccessVer)

For intX = 0 To 99

strTemp = ""
strTemp = objWshShell.RegRead(cPrefijo & strVersion & cSufijo & intX & "\Path")

        If strTemp = "" Then
            funPrimerLocationVacio = intX
            Exit For
        End If
    Next intX

Set objWshShell = Nothing

End Function

+++++++++++++++++++++++++++++++++++++++++++++++++++++++

2- Zona de confianza sin utilizar LOCATION (n)

Para evitar los molestos mensajes de seguridad, es necesario crea un Zona de confianza en Access.
El codigo expuesto sirve tanto para Access 2007 como Access 2010 y No utiliza la clave "Location" que es la clave que por defecto que utiliza Access.

Poner el siguiente codigo en un Modulo standard

Option Explicit

Private Function funTest ()

If MsgBox("¿ Quieres añadir este programa a la zona de confianza ?", vbYesNo + vbQuestion + vbDefaultButton2) = vbOK Then

            If funZonaConfianza = True Then
                  MsgBox "Añadida Zona de Confianza", vbInformation, "Zona de Confianza"
            Else
                  MsgBox "Esta Zona de confianza ya existe", vbExclamation, "Zona de Confianza"
            End If
      End If
End Function

      Dim objWshShell As Object
      Dim strHKEY As String
      Dim strRutaBack As String
      Dim strRutaFront As String
      Dim strTexto As String
      Dim strClave As String
      Dim strVersion As String

strVersion = SysCmd(acSysCmdAccessVer)

      If strVersion = "12.0" Then
            strHKEY = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Access\Security\Trusted Locations\"
      ElseIf strVersion = "14.0" Then
            strHKEY = "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\Trusted Locations\"
      Else
            MsgBox "Version de Access No valida", vbExclamation, "Version Access"
            Exit Function
      End If

Rem Aqui asigno el nombre de la base sin la extension
strClave = Left$(CurrentProject.Name, InStrRev(CurrentProject.Name, ".") - 1) ' <<<< "Pon lo que quieras"

Rem aqui asigno el nombre de la base con la extension
strTexto = Application.CurrentProject.Name ' <<<< "Pon lo que quieras"

Set objWshShell = CreateObject("Wscript.Shell")

strRutaFront = CurrentProject.Path
strRutaBack = objWshShell.RegRead(strHKEY & strClave & "\Path")

      If strRutaBack <> strRutaFront Then
            objWshShell.RegWrite strHKEY & strClave & "\AllowNetworkLocations", 1, "REG_DWORD"
            objWshShell.RegWrite strHKEY & strClave & "\AllowSubfolders", 1, "REG_DWORD"
            objWshShell.RegWrite strHKEY & strClave & "\Date", Format(Now(), "mm/dd/yyyy hh:mm")
            objWshShell.RegWrite strHKEY & strClave & "\Description", strTexto
            objWshShell.RegWrite strHKEY & strClave & "\Path", strRutaFront
            funZonaConfianza = True
      Else
            funZonaConfianza = False
      End If

Set objWshShell = Nothing

End Function

[Atrás]

Microsoft Access ©

Interesante:

Versiones:

Misceláneo:

8- Zona de Confianza