Consulting

Results 1 to 2 of 2

Thread: VBA for Date Expiry does not close WorkBook

  1. #1

    VBA for Date Expiry does not close WorkBook

    Found the below solution on the Web at
    https://www.datanumen.com/blogs/prot...nlicensed-use/


    Option Explicit
    Dim dteExpiry As Date ‘Declare variables
    Dim flagLocked As String
    Dim strPWD As String
    Dim strResult As String

    Sub Auto_open()
    Sheets("Welcome").Visible = True
    Sheets("Main").Visible = xlVeryHidden 'Can't be unhidden by the user
    Sheets("Defaults").Visible = xlVeryHidden

    dteExpiry = Sheets("Defaults").Range("B1") 'Test for Expiry
    strPWD = Sheets("Defaults").Cells(2, 2)
    flagLocked = Sheets("Defaults").Cells(3, 2)

    If dteExpiry < Now() And flagLocked = "No" Then 'Trial period over
    flagLocked = "Yes"
    Sheets("Defaults").Cells(3, 2) = flagLocked
    ActiveWorkbook.Save 'Ensures that flagLocked is set
    MsgBox "The trial period has expired. Please contact xxxx at yyyyy"
    ElseIf flagLocked = "Yes" Then
    strResult = InputBox("Enter password", "Password", vbOKCancel)
    If strResult = strPWD Then
    Sheets("Main").Visible = True 'Reveal the "Main" sheet
    Sheets("Welcome").Visible = False
    Else
    MsgBox "The password is wrong. Please contact xxxx at yyyyy"
    Exit Sub
    End If
    Else ‘Within trial period
    Sheets("Main").Visible = True
    Sheets("Main").Activate
    Sheets("Welcome").Visible = False
    End If
    End Sub

    Sub Auto_Close()
    Sheets("Welcome").Visible = True
    Sheets("Main").Visible = xlVeryHidden
    Sheets("Defaults").Visible = xlVeryHidden
    ActiveWorkbook.Save
    End Sub


    Using EXCEL 2010 – with the code in Module 1

    The workbook does not close if I enter an incorrect password(lockflag set to Yes).
    It just stays open.

    What am I doing wrong??




  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    I didn't see any place that actually closed the workbook

    I added "Thisworkbook.Close False" below and it seems ok

    Be advised that this can be easily circumvented


    Option Explicit
    
    Dim dteExpiry As Date 'Declare variables
    Dim flagLocked As String
    Dim strPWD As String
    Dim strResult As String
    
    
    Sub Auto_open()
        Sheets("Welcome").Visible = True
        Sheets("Main").Visible = xlVeryHidden 'Can't be unhidden by the user
        Sheets("Defaults").Visible = xlVeryHidden
    
        dteExpiry = Sheets("Defaults").Cells(1, 2).Value    '   Test for Expiry
        strPWD = Sheets("Defaults").Cells(2, 2).Value
        flagLocked = Sheets("Defaults").Cells(3, 2).Value
    
        If dteExpiry < Now() And flagLocked = "No" Then 'Trial period over
            flagLocked = "Yes"
            Sheets("Defaults").Cells(3, 2) = flagLocked
            ActiveWorkbook.Save 'Ensures that flagLocked is set
            
            MsgBox "The trial period has expired. Please contact xxxx at yyyyy"
            
            ThisWorkbook.Close False
            'Application.Quit
            
        ElseIf flagLocked = "Yes" Then
            strResult = InputBox("Enter password", "Password", vbOKCancel)
            
            If strResult = strPWD Then
                Sheets("Main").Visible = True 'Reveal the "Main" sheet
                Sheets("Welcome").Visible = False
            Else
                MsgBox "The password is wrong. Please contact xxxx at yyyyy"
                
                ThisWorkbook.Close False
                'Application.Quit
            End If
    
        Else 'Within trial period
            Sheets("Main").Visible = True
            Sheets("Main").Select
            Sheets("Welcome").Visible = False
        End If
    End Sub
    
    
    
    Sub Auto_Close()
        Sheets("Welcome").Visible = True
        Sheets("Main").Visible = xlVeryHidden
        Sheets("Defaults").Visible = xlVeryHidden
        ActiveWorkbook.Save
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Posting Permissions

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