Como soluciono la siguiente cuestión: por motivos de seguridad, o económicos, el libro de Excel que diseñé lleno de macros solo debe ejecutarse en una PC: si el usuario traslada el archivo a otra computadora, no tiene que funcionar más. Veamos como resolverlo.
Si bien hace poco vimos la potencia de las API's a la hora de obtener información o necesitar las funciones de nuestro Sistema Operativo, existe una alternativa muy buena para recabar datos sobre nuestro entorno de trabajo, accediendo al sistema de archivos: el objeto Scripting File System Object, el cual posee una buena cantidad de propiedades, métodos y eventos mas sencillos de comprender y manejar que las API's.[+/-] Ver el resto / Ocultar
Con este objeto (que en adelante llamaré FSO, para no escribir tanto =)), tendremos control sobre archivos, carpetas, directorios, unidades de disco y mas, pudiendo renombrar, eliminar, crear, cambiar atributos, etc, etc sobre los mencionados objetos.
Como el tema da para mucho, y seguramente lo iremos viendo en entradas posteriores, ahora vamos a centrarnos en brindar una solución al planteamiento que se hizo al principio del post.
Un cliente me pide un determinado proyecto y no quiero que luego ande "desparramando" mi archivo por todos lados, ya que me perjudicaría economicamente.
Analicemos: tengo que encontrar una forma de identificar la pc en donde corre el libro de Excel y que no se ejecuten las macros que posee si dicha pc no es la que abrió el archivo por primera vez.
Una buena información que tenemos a nuestro alcance es el numero de serie del disco rígido. Le envio el archivo a mi cliente y:
1) cuando abre el libro por primera vez tomo su el serial de su disco y lo almaceno.
2) en sucesivas aperturas, comparo el nro guardado con el que posee el disco de la pc sobre la cual se está ejecutando el archivo.
3) si los nros del punto anterior coinciden, todo funciona normalmente. De lo contrario, cierro el libro.
Armada la solución en forma lógica, pasemos a la codificación de este proyecto:
a) Abrimos el Editor de VBA (alt + f11), nos dirigimos a "herramientas / referencias" y buscamos el ítem: "Microsoft Scripting Runtime". Lo tildamos. Con esto nos aseguramos de incluir dentro de nuestro archivo todas las dependencias necesarias para hacer que FSO funcione.
b) Insertamos un nuevo módulo e incorporamos el siguiente código. Aqui les muestro como funciona el Sub, mas adelante detallaré todo completamente:
'creo el objeto que luego invocaré: Dim FSO As New FileSystemObject Sub LeerDisco() 'creo una variable del tipo Disco: Dim EsteDisco As Drive Dim RutaSO As String 'veamos donde está el directorio del sistema: RutaSO = Environ("windir") 'y tomemos los primeros tres caracteres, que corresponden a la 'letra del disco: RutaSO = Left(RutaSO, 3) 'seteo a EsteDisco como el disco del sistema, así me garantizo de 'estar siempre leyendo la unidad principal de la pc: Set EsteDisco = FSO.GetDrive(RutaSO) MsgBox "Serie: " & EsteDisco.serialnumber & vbCrLf & "Disco del sistema: " & RutaSO Set FSO = Nothing Set EsteDisco = Nothing End Sub
Con el código anterior obtenemos este simple mensaje, pero que lo es todo:
Insertamos una hoja de cálculos, a la cual llamaremos "xxx". En el rango A1 de dicha planilla guardaremos el número de serie, para chequearlo en futuras aperturas. La hoja "xxx" no deberá ser vista por nadie, así que nos aseguraremos de ello, poniendo su propiedad "Visible" en xlVeryHidden.
Para que este ejemplo les funcione correctamente, añaden otra hoja y la llaman "Inicio", ocultandola igual que la anterior. Supuestamente es allí donde pondremos el menú que permita el acceso a nuestras funciones. Si el serial guardado coincide con el de la pc, muestro la hoja Inicio, de lo contrario, cierro el archivo.
Otra cosa a tener en cuenta es que nuestro código deberá ejecutarse automáticamente cada vez que se abra el libro, así que utilizaremos el procedimiento Sub Auto_Open() dentro del módulo que insertamos.
Borramos el código anterior, ya que era de ejemplo, y colocamos el siguiente:
'creo el objeto que luego invocaré: Dim FSO As New FileSystemObject Sub Auto_Open() 'creo una variable del tipo Disco: Dim EsteDisco As Drive Dim RutaSO As String Dim Serial 'veamos donde está el directorio del sistema: RutaSO = Environ("windir") 'y tomemos los primeros tres caracteres, que corresponden a la 'letra del disco: RutaSO = Left(RutaSO, 3) 'seteo a EsteDisco como el disco del sistema, así me garantizo de 'estar siempre leyendo la unidad principal de la pc: Set EsteDisco = FSO.GetDrive(RutaSO) Serial = EsteDisco.SerialNumber 'si la celda está vacía, el archivo se abre x primera vez: If Sheets("xxx").Range("A1").Value = "" Then 'entonces guardo el nro de serie del disco Sheets("xxx").Range("a1").Value = Serial Else If Sheets("xxx").Range("a1").Value <> Serial Then 'aviso MsgBox "Ud no está autorizado a leer este archivo", vbCritical 'y me voy, sin guardar los cambios: ActiveWorkbook.Close xlDoNotSaveChanges Else 'si los numeros coinciden, hago visible la hoja en donde, 'hipoteticamente, tengo el menú de acceso a todas mis 'funciones: Sheets("Inicio").Visible = True Sheets("Inicio").Select End If End If 'destruyo los objetos, para liberar los recursos del sistema Set FSO = Nothing Set EsteDisco = Nothing End Sub
Todo muy lindo.... ¿lo enviamos a nuestro cliente? Si, podríamos, pero el archivo no le funcionaría.... por que se lleva guardado el serial de mi disco rígido. ¿que hacemos?
Una solución sencilla en extremo sería:
En la hoja "xxx", y dentro de alguna celda (exceptuando A1, que la utilizamos con otros propósitos), deberíamos ingresar algún valor del tipo "bandera". Por ejemplo: en A2 el valor 1. Al cerrar el archivo que nos aprontamos a enviar, si el valor de la celda A2 es = 1, entonces borramos nuestro número de serie y ese 1. Una alerta sencilla y eficaz. Nos vamos a la ventana de código correspondiente a ThisWorkbook y escribimos lo siguiente, en el evento BeforeClose (antes de cerrar):
Private Sub Workbook_BeforeClose(Cancel As Boolean) With Sheets("xxx") 'si A2 posee el valor 1 quiere decir que aun el libro 'está en mi propiedad y lo estoy cerrando antes de 'enviarlo: If .Range("a2").Value = 1 Then 'borro el serial de mi disco .Range("a1").Value = "" 'y borro el 1 presente en A2, para que no vuelva 'a ejecutarse este Sub en futuros cierres del 'archivo: .Range("a2").Value = "" 'para evitar cualquier olvido... guardo: ActiveWorkbook.Save End If End With End Sub
Solo nos resta proteger nuestro proyecto por contraseña y todo queda listo. (explorador de proyectos / vbaproyect / boton derecho del mouse / propiedades / pestaña proteccion / activar casilla de protección / introducir contraseña (que sea una de las "fuertes").
- Obtener enlace
- X
- Correo electrónico
- Otras aplicaciones
Etiquetas
Macros
Etiquetas:
Macros
- Obtener enlace
- X
- Correo electrónico
- Otras aplicaciones
GRAN PAGINA..!!
ResponderEliminargracias por tu comentario, estimado. espero que encuentres cosas de utilidad en mi blog.
ResponderEliminarsaludos.
Hola Damian, gracias por tu valioso aporte, yo tengo el excel 2013, y me sale se ha producido el siguiente error 424 en tiempo de ejecucion, ejecutando el F8 me depura el :
ResponderEliminarSet EsteDisco = FSO.GetDrive(RutaSO)
Anónimo: me alegro que el aporte te sirva. El problema que te sale no e3s culpa del Office 2013, el culpable es... mi blog. Si copias y pegas el código que expongo, luego te arroja errores, por la inclusión implícita de caracteres no visibles (ni imprimibles) que, realmente no se por qué, dañan el código.
ResponderEliminarHacé lo siguiente: escribe tu mismo el código, tal cual lo ves en esta página, y no fallará.
Por las dudas, y para ver si te sirve, copio aquí el código:
'creo el objeto que luego invocaré:
Dim FSO As New FileSystemObject
Sub LeerDisco()
'creo una variable del tipo Disco:
Dim EsteDisco As Drive
Dim RutaSO As String
'veamos donde está el directorio del sistema:
RutaSO = Environ("windir")
'y tomemos los primeros tres caracteres, que corresponden a la
'letra del disco:
RutaSO = Left(RutaSO, 3)
'seteo a EsteDisco como el disco del sistema, así me garantizo de
'estar siempre leyendo la unidad principal de la pc:
Set EsteDisco = FSO.GetDrive(RutaSO)
MsgBox "Serie: " & EsteDisco.serialnumber & vbCrLf & "Disco del sistema: " & RutaSO
Set FSO = Nothing
Set EsteDisco = Nothing
End Sub