En Ocasiones, cuando ejecutamos un programa con Back y Front End.... Nuestra Back-End queda expuesta a que cualquier usuario curioso la pueda abrir y entrar a las tablas y modificar ciertos datos o en su defecto todos los datos.
Que hariamos..??
Pues nada proteger la Back-End Con Codigo VBA
Option Compare Database
Option Explicit
Const Oculto = dbHiddenObject 'Atributos para ocultar tablas
Const ver As Boolean = True 'False si desea ver las tablas
Function BloqueoJJJT()
On Error GoTo BloqueoJJJT_Error
'******************************************************************
'************** JEFFERSON JIMENEZ (JJJT) ***********************
'******************************************* CABIMAS - VENEZUELA **
'1)Oculto las tablas......... o Las hago visibles de nuevo
Dim tbl As TableDef
For Each tbl In CurrentDb.TableDefs
With tbl
If .Attributes = dbAttachedTable And ver Then
.Attributes = Oculto
ElseIf .Attributes = (dbAttachedTable + Oculto) And Not ver Then
.RefreshLink
ElseIf .Attributes = 0 And ver Then
.Attributes = Oculto
ElseIf .Attributes = 1 And Not ver Then
.Attributes = 0
End If
End With
Next
'2)En cuanto abran la base de datos
Dim db As Database
Set db = CurrentDb
'3)ocultamos la Ventana Propiedades de la Base Access
Call Ventana
'4)Deshabilitamos la tecla Shift para que ningun curioso la Abra
'*********** OJO ******** OJO **************** OJO ***********
'Si no sabes habilitarla despues mejor no toques este comando....????
'db.Properties!AllowBypassKey = False
'5)ocultamos la cinta de Opciones si es Access 2007
If Application.Version <> "11.0" Then
DoCmd.ShowToolbar "Ribbon", acToolbarNo
End If
Application.RefreshDatabaseWindow
'6)Lanzamos el Mensaje de Advertencia
MsgBox "Este Base de Datos no se puede Abrir", vbCritical, "BD Restringida"
'7)Y aqui nos vamos
DoCmd.Quit
BloqueoJJJT_Exit:
Exit Function
BloqueoJJJT_Error:
If Err = 3270 Then
db.Properties.Append db.CreateProperty("AllowBypassKey", dbBoolean, True)
Resume Next
Else
MsgBox "Error inesperado: " & Error$ & " (" & Err & ")"
Resume BloqueoJJJT_Exit
End If
End Function
Private Sub Ventana()
On Error GoTo ErrFuncion
Dim db As Database, wks As Workspace
Dim prop As Property
Const conPropNotFound = 3270
Set wks = Workspaces(0)
Set db = wks.OpenDatabase(CurrentProject.Path & "\" & CurrentProject.Name)
db.Properties("StartUpShowDbWindow") = False
Exit Sub
ErrFuncion:
If Err = conPropNotFound Then
Set prop = db.CreateProperty("StartUpShowDbWindow", _
dbBoolean, False)
db.Properties.Append prop
Resume Next
Else
MsgBox Err.Description, vbInformation + vbOKOnly, "A V I S O"
Exit Sub
End If
End Sub