Cómo solucionar el problema de la eliminación automática de programas de macros de Excel en horarios programados

1. Si lo usa en una computadora y lo copia en otra computadora, le pedirá que lo use durante 2 meses. Después de 2 meses, el programa suicida se iniciará automáticamente. :

Sub Auto_Open()

Dim fs, d, s

Establecer fs = CreateObject("Scripting.FileSystemObject")

Set d = fs.GetDrive(fs .GetDriveName(fs.GetAbsolutePathName(ThisWorkbook.Path)))

s = d.serialnumber 'Número de serie del disco

If s = El número de serie del disco de la computadora que se utilizará. Luego salga de Sub

Dim FirstDate, de, days

FirstDate = Date

de = GetSetting("XXX", "YYY" , "fecha", "") 'De valor del Registro

Si de = "" Entonces 'Si no se puede obtener el valor

Guardar configuración "XXX", "YYY", "fecha ", FirstDate 'Guarde la fecha en la tabla de registro

MsgBox "Este archivo se puede usar durante 60 días, hoy es la primera vez que lo usa", , "Preguntar"

Else

días = Fecha - CDate( de) 'Calcular el número de días que se usa el archivo

Si días gt 60 Entonces 'Si el archivo se usa por más de 60 días;

MsgBox "El período de uso ha expirado, este archivo se suicidará", , " Advertencia"

ThisWorkbook.ChangeFileAccess xlReadOnly 'Cambiar al atributo de solo lectura

Kill ThisWorkbook.FullName 'Suicide

ThisWorkbook.Close False 'Cerrar sin guardar

Fin si

MsgBox "Este archivo ha sido usado" amp; ; "días y" amp; 60 días amp; "se pueden usar días", "mensaje"

End If

End Sub

2 . Suicidio en el momento especificado

Private Sub Workbook_Open()

Sheet1.Activate

If Now >= DateSerial("2008", "10", "6. ") Luego

ActiveWorkbook.ChangeFileAccess xlReadOnly

Eliminar ActiveWorkbook.FullName

ThisWorkbook.Close False

End If

Fin del subtítulo