Here is a piece of code i found which does what i want-ish.

Trouble is the guy who did it for me is now long gone !!!!

Anyone help??

Because iy had no ' labelling so i can't follow it.


Many thanks





Option Explicit

Sub RegFrm_CheckLicence(Optional bLicenced, Optional bReport, Optiona
strPath)
Dim strtemp As String
Dim lKey1 As Long
Dim lKey2 As Long
Dim lKey3 As Long
Dim dDate1 As Variant
Dim dDate2 As Variant
Dim dDate3 As Variant
Dim Date1 As Date
Dim Date2 As Date
Dim Date3 As Date
Dim i As Integer

bLicenced = True
If IsMissing(bReport) Then bReport = False
If IsMissing(strPath) Then strPath = ThisWorkbook.Path
"\serial.lic"
Application.StatusBar = "Checking program licence"
If Not FileExists(strPath) Then
strtemp = InputBox("Please contact IT administrator for licenc
number and enter below", "MESG Licence")
If strtemp = "666" Then
bLicenced = True
i = GetSetting("RegFrm", "Valid", "Count", 10)
SaveSetting "RegFrm", "Valid", "Count", i - 1
If i <= 0 Then
bLicenced = False
Else
If i = 1 Then
MsgBox "You have " & i & " trial of this softwar
left!" & vbCr & "Contact xyz inc for a licence number", vbExclamation
AppName
Else
MsgBox "You have " & i & " trials uses of thi
application left!", vbExclamation, AppName
End If
End If
GoTo Crash_Out
Else
If Len(strtemp) < 18 Then
MsgBox "Licence number invalid", vbCritical, "MES
Licence"
bLicenced = False
GoTo Crash_Out
Else
Close #1
Open ThisWorkbook.Path & "\serial.lic" For Output A
#1
Print #1, strtemp
Close #1
End If
End If
End If
Close #1
Open strPath For Input As #1
Input #1, strtemp
Close #1
If Len(strtemp) = 18 Then
lKey1 = 723456
lKey2 = 431007
lKey3 = 328888
dDate1 = Val(Mid(strtemp, 1, 6))
dDate2 = Val(Mid(strtemp, 7, 6))
dDate3 = Val(Mid(strtemp, 13, 6))
dDate1 = lKey1 Xor dDate1
dDate2 = lKey2 Xor dDate2
dDate3 = lKey3 Xor dDate3
dDate1 = Format(dDate1, "000000")
dDate2 = Format(dDate2, "000000")
dDate3 = Format(dDate3, "000000")
Date1 = CDate(Mid(dDate1, 1, 2) & "/" & Mid(dDate1, 3, 2) & "/
& Mid(dDate1, 5, 2))
Date2 = CDate(Mid(dDate2, 1, 2) & "/" & Mid(dDate2, 3, 2) & "/
& Mid(dDate2, 5, 2))
Date3 = CDate(Mid(dDate3, 1, 2) & "/" & Mid(dDate3, 3, 2) & "/
& Mid(dDate3, 5, 2))
If bReport Then
MsgBox "LIC Creation Date " & Format(Date1, "dd mm
yyyy")
MsgBox "First Expiry Date " & Format(Date2, "dd mm
yyyy")
MsgBox "Second Expiry Date (30 days later) "
Format(Date3, "dd mmm yyyy")
End If
If Date3 - Date2 = 30 Then
If Now < Date1 Then
bLicenced = False
ElseIf Now Date3 Then
bLicenced = False
'ElseIf Now (Date2 + 28) Then
' MsgBox "Your licence will expire shortly" & vbCr
"Contact support...", vbCritical, "MESG Licence"
End If
SaveSetting "RegFrm", "Valid", "Count", 10
Else
bLicenced = False
End If
Else
bLicenced = False
End If
Crash_Out:
Application.StatusBar = "Ready"
End Su

--
Message posted from http://www.ExcelForum.com