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)
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
'---------------------------------------------------------------------------------------
' Procedure : funPrimerLocationVacio
' DateTime : 31/01/2010
' Author : Javier Gomez ("Javier.Mil")
' WEB : www.accessdemo.info
' Purpose :Busca el primer Location vacio o libre
'---------------------------------------------------------------------------------------
Dim strTemp As String
Dim intX As Integer
Dim strVersion As String
strVersion = SysCmd(acSysCmdAccessVer)
strTemp = objWshShell.RegRead(cPrefijo & strVersion & cSufijo & intX & "\Path")
funPrimerLocationVacio = intX
Exit For
End If
Next intX
+++++++++++++++++++++++++++++++++++++++++++++++++++++++
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.
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
