Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 30
to be something like
Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 1/144
Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 1 / 144
Sub TimeBombWithDefinedName()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TimeBombWithDefinedName
' This procedure uses a defined name to store this workbook's
' expiration date. If the expiration date has passed, a
' MsgBox is displayed and this workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ExpirationDate As String
On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
ExpirationDate = CStr(Now + C_NUM_DAYS_UNTIL_EXPIRATION)
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, close the
' workbook. If the defined name didn't exist, we need
' to Save the workbook to save the newly created name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If CDate(Now) > CDate(ExpirationDate) Then
MsgBox "This workbook trial period has expired.", vbOKOnly
ThisWorkbook.Close savechanges:=False
End If
End Sub
Private Sub Workbook_Open()
TimeBombWithDefinedName
End Sub
ThisWorkbook.Names("expirationdate").Value
Sub ClearName()
On Error Resume Next
ThisWorkbook.Names("ExpirationDate").Delete
End Sub
Hi Can you repost this code. for some reason i am not able to see the code.Oops, I missed that part where Chip's code forces the expiration into a single date. I think this will setup a 10 minutes trial period.
[pre][/pre]Code:Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 1 / 144 Sub TimeBombWithDefinedName() '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' TimeBombWithDefinedName ' This procedure uses a defined name to store this workbook's ' expiration date. If the expiration date has passed, a ' MsgBox is displayed and this workbook is closed. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim ExpirationDate As String On Error Resume Next ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2) If Err.Number <> 0 Then ''''''''''''''''''''''''''''''''''''''''''' ' Name doesn't exist. Create it. ''''''''''''''''''''''''''''''''''''''''''' ExpirationDate = CStr(Now + C_NUM_DAYS_UNTIL_EXPIRATION) ThisWorkbook.Names.Add Name:="ExpirationDate", _ RefersTo:=Format(ExpirationDate, "short date"), _ Visible:=False End If '''''''''''''''''''''''''''''''''''''''''''''''''''''' ' If the today is past the expiration date, close the ' workbook. If the defined name didn't exist, we need ' to Save the workbook to save the newly created name. '''''''''''''''''''''''''''''''''''''''''''''''''''''' If CDate(Now) > CDate(ExpirationDate) Then MsgBox "This workbook trial period has expired.", vbOKOnly ThisWorkbook.Close savechanges:=False End If End Sub
Sure thing.Hi Can you repost this code. for some reason i am not able to see the code.
Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 1 / 144
Sub TimeBombWithDefinedName()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TimeBombWithDefinedName
' This procedure uses a defined name to store this workbook's
' expiration date. If the expiration date has passed, a
' MsgBox is displayed and this workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ExpirationDate As String
On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
ExpirationDate = CStr(Now + C_NUM_DAYS_UNTIL_EXPIRATION)
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, close the
' workbook. If the defined name didn't exist, we need
' to Save the workbook to save the newly created name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If CDate(Now) > CDate(ExpirationDate) Then
MsgBox "This workbook trial period has expired.", vbOKOnly
ThisWorkbook.Close savechanges:=False
End If
End Sub
Thanks Luke, really appreciate that.Cleaned up code:
Code:
Sure thing.
Code:Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 1 / 144 Sub TimeBombWithDefinedName() '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' TimeBombWithDefinedName ' This procedure uses a defined name to store this workbook's ' expiration date. If the expiration date has passed, a ' MsgBox is displayed and this workbook is closed. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim ExpirationDate As String On Error Resume Next ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2) If Err.Number <> 0 Then ''''''''''''''''''''''''''''''''''''''''''' ' Name doesn't exist. Create it. ''''''''''''''''''''''''''''''''''''''''''' ExpirationDate = CStr(Now + C_NUM_DAYS_UNTIL_EXPIRATION) ThisWorkbook.Names.Add Name:="ExpirationDate", _ RefersTo:=Format(ExpirationDate, "short date"), _ Visible:=False End If '''''''''''''''''''''''''''''''''''''''''''''''''''''' ' If the today is past the expiration date, close the ' workbook. If the defined name didn't exist, we need ' to Save the workbook to save the newly created name. '''''''''''''''''''''''''''''''''''''''''''''''''''''' If CDate(Now) > CDate(ExpirationDate) Then MsgBox "This workbook trial period has expired.", vbOKOnly ThisWorkbook.Close savechanges:=False End If End Sub