+ Reply to Thread
Results 1 to 4 of 4

Using TimeBombMakeReadOnly gives run-time error?

Hybrid View

  1. #1
    Registered User
    Join Date
    12-17-2010
    Location
    The D
    MS-Off Ver
    Excel 2007
    Posts
    23

    Using TimeBombMakeReadOnly gives run-time error?

    I am using Chip Pearson's code for setting a timebomb. However I am getting a run-time error '1004' Application-defined or object-defined error when the ExpirationDate is set on the second line of execution. Shouldn't this run as is or am I missing something here? I don't get why the error isn't handled with the "On Error" code ...

    Sub TimeBombMakeReadOnly()
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' TimeBombMakeReadOnly
    ' This procedure uses a defined name to store the expiration
    ' date and if the workbook has expired, makes the workbook
    ' read-only.
    '
    ' Source: http://www.cpearson.com/excel/workbooktimebomb.aspx
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
        Dim ExpirationDate As String
        Dim NameExists As Boolean
    
        On Error Resume Next
        ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
        If Err.Number <> 0 Then
            '''''''''''''''''''''''''''''''''''''''''''
            ' Name doesn't exist. Create it.
            '''''''''''''''''''''''''''''''''''''''''''
            ExpirationDate = CStr(DateSerial(Year(Now), _
                                             Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
            ExpirationDate = CStr(DateSerial(Year(C_WORKBOOK_ISSUE_DATE), _
                                             Month(C_WORKBOOK_ISSUE_DATE), Day(C_WORKBOOK_ISSUE_DATE) + C_NUM_DAYS_UNTIL_EXPIRATION))
            ThisWorkbook.Names.Add Name:="ExpirationDate", _
                                   RefersTo:=Format(ExpirationDate, "short date"), _
                                   Visible:=False
            NameExists = False
        Else
            NameExists = True
        End If
    
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' If the today is past the expiration date, make the
        ' workbook read only. We need to Save the workbook
        ' to keep the newly created name intact.
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If CDate(Now) >= CDate(ExpirationDate) Or CDate(Now) < CDate(C_WORKBOOK_ISSUE_DATE) Then
            If NameExists = False Then
                ThisWorkbook.Save
            End If
            ThisWorkbook.ChangeFileAccess xlReadOnly
        End If
        ThisWorkbook.Names.Add.Delete
    End Sub

  2. #2
    Forum Expert shg's Avatar
    Join Date
    06-20-2007
    Location
    The Great State of Texas
    MS-Off Ver
    2010, 2019
    Posts
    40,689

    Re: Using TimeBombMakeReadOnly gives run-time error?

    You must have a defined name ExpirationDate that contains the date.
    Entia non sunt multiplicanda sine necessitate

  3. #3
    Registered User
    Join Date
    12-17-2010
    Location
    The D
    MS-Off Ver
    Excel 2007
    Posts
    23

    Re: Using TimeBombMakeReadOnly gives run-time error?

    It seems that this code was written to accommodate the pre-existing definition of the name (hence the On Error Resume Next handling). Testing this routine in a brand new workbook causes the same error, so I don't see how this can be the problem.

  4. #4
    Forum Expert shg's Avatar
    Join Date
    06-20-2007
    Location
    The Great State of Texas
    MS-Off Ver
    2010, 2019
    Posts
    40,689

    Re: Using TimeBombMakeReadOnly gives run-time error?

    Do you have the constants C_WORKBOOK_ISSUE_DATE and C_NUM_DAYS_UNTIL_EXPIRATION defined?

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1