How To Make Workbook Expire After Date Set In File On Website (Text Document or HTML File)

[ryancdavis]

Hi Everyone -

I am trying to figure out how to modify some existing code that I have, that currently works well, to expire a workbook after a certain date. Currently, I have this working by setting the expiration date locally within the workbooks VBA code. I'd like to somehow modify this code to make it check a .txt or .html file on my website to see if the workbook is valid, rather than doing it by the date set locally.

The main purpose of this is to ensure that once a new version of the workbook is created, that I can update the .txt or .html file to expire other versions I deem "Outdated". Currently, I allow an override code to be entered if the workbook is expired, allowing the workbook to function as it was before it expired.

I have all of the code working to do this locally within the workbook only right now, so I am hopeful that with a little modification to the code, it can be made to check the workbook filename and if valid (true or false) within the .txt or .html file on my website, run the correct code to either allow the workbook to open or throw an expired message and allow an override code (that is also pulled for that workbook via the .txt or .html file on my website).

Does anyone have any ideas on how to do this? I have included the code I have working now on a local file level below for review.

Thanks for any help. It is much appreciated.

Public MyDate As Variant
Public Passwd As String
Private Sub WorkBook_Open()

'ID LIKE TO SET "MyDate" TO BE PULLED FROM A TXT OR HTML FILE ONLINE
MyDate = #12/26/2019#  ' ADD THE DATE WHEN THIS WORKBOOK SHOULD EXPIRE

'ID LIKE TO SET "Passwd" TO PULL THE WORKBOOK SPECIFIC OVERRIDE PASSWORD FROM THE TXT OR HTML FILE ONLINE
Passwd = "12345" 'OVERRIDE PASSWORD

Application.ScreenUpdating = False
Sheets("Loading...").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Outdated Version...").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("#Builder").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Estimate Request").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Proposal").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("New Project Packet").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
'Sheets("Internal Routing Packet").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
'Sheets("Event Log").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Administrator").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Application.ScreenUpdating = True

'THIS CODE BELOW CHECKS IF THE WORKBOOK HAS EXPIRED.
If Date > MyDate Then
Application.ScreenUpdating = False
Sheets("Outdated Version...").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED 'HIDDEN PAGES MUST BE LISTED LAST. IF YOU WANT TO MODIFY THIS PAGE, YOU MUST SET TO '= True' TO VIEW PAGE, MAKE CHANGES, AND SET BACK TO '= False'.Sheets("#Builder").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Loading...").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Estimate Request").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Proposal").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("New Project Packet").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
'Sheets("Internal Routing Packet").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
'Sheets("Event Log").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Administrator").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Application.ScreenUpdating = True

'THROW AN ERROR MESSAGE STATING BETA/EVALUATION HAS EXPIRED
  MsgBox "Oops! It appears that this is a beta/evaluation version and the evaluation period for this version has expired. If you have been provided an override passcode to access this utility, you will be prompted to enter it upon clicking the'OK' button below." & vbCrLf & vbCrLf & _
         "If you feel that this is an error, please contact Ryan or additional assistance and support.", vbCritical, "Beta/Evaluation Period Has Expired"

'THROW AN INPUT BOX FOR OVERRIDE PASSCODE
  mbox = Application.InputBox("If you have an override passcode, please enter it now to continue using this utility. If you do not have an override passcode, click the 'Cancel' button to close this utility.", "Override Passcode")

'CHECK THE PASSWORD IF ENTERED AND IF CORRECT, LOAD ALL SHEETS AND HIDE ERROR SHEETS. IF PASSWORD IS WRONG, IT WILL EXIT EXCEL.
  If mbox <> Passwd Then
  MsgBox "We apologize for the inconvenience, but the passcode you entered is incorrect. Unfortuntely, due to security protocols, this document will now be closed and any modifications to this document will not be saved." & vbCrLf & vbCrLf & _
           "If you feel this is an error, please contact Ryan for additional assistance and support - or to request an override passcode.", vbCritical, "Incorrect Password"
    
    With ThisWorkbook
      'Kill .FullName
      .Close SaveChanges:=False
    End With
    Application.Quit

Else

'SHOW ALL PAGES IF A VALID PASSWORD IS ENTERED WITHIN AN EXPIRED WORKBOOK (THE CODE BELOW IS ONLY APPLICABLE WHEN AN OVERRIDE CODE IS PROMPTED)
Application.ScreenUpdating = False
Sheets("#Builder").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Estimate Request").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Proposal").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("New Project Packet").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
'Sheets("Internal Routing Packet").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
'Sheets("Event Log").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Administrator").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Loading...").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Evaluation Expired...").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED 'HIDDEN PAGES MUST BE LISTED LAST. IF YOU WANT TO MODIFY THIS PAGE, YOU MUST SET TO '= True' TO VIEW PAGE, MAKE CHANGES, AND SET BACK TO '= False'.
Application.ScreenUpdating = True
End If

Else

'THIS CODE BELOW CHECKS IF THE WORKBOOK IS STILL VALID AND HAS NOT EXPIRED YET.
If Date < MyDate Then
 
'THOW A INFORMATIONAL POPUP BOX STATING THE WORKSHEET IS STILL VALID.
MsgBox "You're good to go! This version is still valid and has not been updated since this release." & vbCrLf & vbCrLf & _
"Click the 'OK' button below to start utilizing this utility now.", vbInformation, "Valid Version"
    
'SHOW ALL NECESSARY PAGES IF DATE IS VALID AND WORKBOOK AS NOT EXPIRED (THIS CODE IS APPLICABLE ONLY WHEN THE DATE IS VALID AND HAS NOT EXPIRED)
Application.ScreenUpdating = False
Sheets("#Builder").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Estimate Request").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Proposal").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("New Project Packet").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
'Sheets("Internal Routing Packet").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
'Sheets("Event Log").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Administrator").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Loading...").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Outdated Version...").Visible = False 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED 'HIDDEN PAGES MUST BE LISTED LAST. IF YOU WANT TO MODIFY THIS PAGE, YOU MUST SET TO '= True' TO VIEW PAGE, MAKE CHANGES, AND SET BACK TO '= False'.
Application.ScreenUpdating = True
End If

End If

End Sub

'THIS CODE IS TO HIDE ALL SHEETS EXCEPT THE LOADING PAGE UPON CLOSING THE WORKBOOK. THIS ENSURES THAT
'WHEN THE WORKBOOK IS REOPENED THAT THE USER MUST ENABLE MACROS TO SHOW THE UTILITY SHEETS AND HIDES
'ALL NOTICE AND ERROR SHEETS.

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.ScreenUpdating = False
Sheets("Loading...").Visible = True 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Outdated Version...").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("#Builder").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Estimate Request").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("New Project Packet").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Proposal").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
'Sheets("Internal Routing Packet").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
'Sheets("Event Log").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED
Sheets("Administrator").Visible = xlVeryHidden 'IF TAB NAME CHANGES, THIS REFERENCE WILL NEED TO BE UPDATED