zona de confianza

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)

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

 

Public Function funZonaConfianza () As Boolean
'---------------------------------------------------------------------------------------
' Procedure : funZonaConfianza
' DateTime  : 23/01/2010  20:46
' Author     :  Javier Gomez ("Javier.Mil")
' email        : 
javier.news@gmail.com
' WEB       : 
www.accessdemo.info
' Purpose   : Crear una Zona de confianza para Access 2007 y Access 2010 Sin utilizar "LOCATION (n)"

'---------------------------------------------------------------------------------------

      On Error Resume Next


      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]