Automatically close Workbook after inactivity

Question

I created a Macro that closes the WB after some time of inactivity. It works perfect if I manually open the file, but if I use another macro from a different WB to open the file, it won't close automatically after the set inactivity time. The code I used to automatically close it is:

This Workbook module:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    stop_Countdown
ThisWorkbook.Save
End Sub
Private Sub Workbook_Open()
    start_Countdown
    End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    stop_Countdown
    start_Countdown
    End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    stop_Countdown
    start_Countdown
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    stop_Countdown
    start_Countdown
End Sub

Regular Module:

Option Explicit
Public Close_Time As Date
Sub start_Countdown()
    Close_Time = Now() + TimeValue("00:00:10")
    Application.OnTime Close_Time, "close_WB"
    End Sub
Sub stop_Countdown()
    Application.OnTime Close_Time, "close_WB", , False
    End Sub
Sub close_wb()
    ThisWorkbook.Close True
    End Sub

The code of the other macro:

Sub Answer_Quote()

Worksheets("UI RM").Protect DrawingObjects:=False, Contents:=False, Scenarios:=False, Password:="045"

 Dim wBook As Workbook
    On Error Resume Next
    Set wBook = Workbooks("Base de Datos Cotizaciones Shared.xlsb")

    If wBook Is Nothing Then 'Not open
            Set wBook = Nothing
            On Error GoTo 0
    Else 'It is open
            wBook.Close SaveChanges:=False
            Set wBook = Nothing
            On Error GoTo 0
    End If

Set wb4 = ActiveWorkbook
Range("AM7").Calculate
Range("K26:K28").Calculate
Dim arreglo(4) As Variant
arreglo(0) = Range("hour_sent").Value
arreglo(1) = Range("day_sent").Value
arreglo(2) = Range("respuesta").Value
arreglo(3) = Range("UsernameRM").Value

Dim Findwhat As String
Dim c, d, multirange As Range
Findwhat = Range("F11").Text

    Dim contador As Integer
    contador = 0
    While (IsFileOpen("\\3kusmiafs02\CARPETA COMERCIAL\Cotizaciones\Base de Datos Cotizaciones Shared.xlsb") And contador < 4)
        contador = contador + 1
        Application.Wait (Now + TimeValue("00:00:03"))
    Wend

    If contador = 4 Then
    MsgBox "La base de datos esta siendo utilizada por otro usuario. Por favor vuelva a intentarlo", vbExclamation, "Proceso cancelado"
    Exit Sub
    End If

Application.ScreenUpdating = False
Dim iStatus As Long
Err.Clear
On Error Resume Next
Set wb2 = Workbooks("Base de Datos Cotizaciones Shared.xlsb")
iStatus = Err
On Error GoTo 0
If iStatus Then 'workbook isn't open
Workbooks.Open filename:="\\3kusmiafs02\CARPETA COMERCIAL\Cotizaciones\Base de Datos Cotizaciones Shared.xlsb"
Else
'workbook is open
wb2.Activate
End If

On Error GoTo errHandler:

'Copy Hour Sent
Worksheets("Data").Activate
Set c = Range("A:A").Find(Findwhat, LookIn:=xlValues)
For j = 1 To 3
    c.Offset(0, 17 + j) = arreglo(j - 1)
Next j
c.Offset(0, 29) = arreglo(3)


'Save Database
Workbooks("Base de Datos Cotizaciones Shared.xlsb").Save
Workbooks("Base de Datos Cotizaciones Shared.xlsb").Close

    'Step-Back into User Interface
    wb4.Activate
    Worksheets("UI RM").Activate

    'Send E-Mail

    'Working in 2000-2010
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim response As Variant


    'Mail recipients

     Dim mail_recipients(3) As String

     'mail_recipients(1) = Range("email").Value
     'mail_recipients(2) = "mail"
     mail_recipients(3) = "mail2"


    'Source Set/Range selection

     Set Source = Nothing
     On Error Resume Next

    Worksheets.Add(After:=Worksheets("Interline Costs")).Name = "Quote Snap"

    'copy temp info
    Worksheets("UI RM").Activate
    Range("B7:G31").SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("quote snap").Activate
    Range("b2").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste

    'copy temp dims
    Worksheets("UI rm").Activate
    Range("I21:s33").SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
    Worksheets("Quote Snap").Activate
    Range("H3").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("j:j").Select
    Selection.ColumnWidth = 12

    'select temp sheet
    Range("A1:V600").Select


Set Source = Selection.SpecialCells(xlCellTypeVisible)


    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells.Interior.Pattern = xlSolid
        .Cells.Interior.PatternColorIndex = xlAutomatic
        .Cells.Interior.ThemeColor = xlThemeColorDark1
        .Cells.Interior.TintAndShade = 0
        .Cells.Interior.PatternTintAndShade = 0
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False

    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Response to Quote #" & wb4.Worksheets("UI RM").Range("F11")

    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2010
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        For i = 1 To 3
            .SendMail Recipients:=mail_recipients, _
                     Subject:="Response to Quote #" & wb4.Worksheets("UI RM").Range("quote_num") & " " & wb4.Worksheets("UI RM").Range("client") & " " & wb4.Worksheets("UI RM").Range("destination") & " " & wb4.Worksheets("UI RM").Range("total_KGS") & " KGS"

            If Err.Number = 0 Then Exit For
        Next i
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Application.DisplayAlerts = False
    wb4.Worksheets("quote snap").Delete
    Application.DisplayAlerts = True


MsgBox "Proceso Terminado"

wb4.Sheets("UI RM").Range("limpiar").ClearContents
wb4.Sheets("UI RM").Range("F29").ClearContents
wb4.Sheets("UI RM").Range("E43:I80").ClearContents

    'Starting Point
    wb4.Worksheets("UI RM").Activate
    Range("F11").Select

Application.Calculation = xlCalculationManual

Worksheets("UI RM").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="045"


Exit Sub

errHandler:

Dim wBook1 As Workbook
    On Error Resume Next
    Set wBook1 = Workbooks("Base de Datos Cotizaciones Shared.xlsb")

    If wBook1 Is Nothing Then 'Not open
            Set wBook1 = Nothing
            On Error GoTo 0
    Else 'It is open
            wBook1.Close SaveChanges:=False
            Set wBook1 = Nothing
            On Error GoTo 0
    End If
MsgBox "Hubo un error", vbExclamation, "Error"

End Sub

Any ideas?

Answer 1

As Susilo pointed out in the comments, the issue must be something else than the auto-close code itself, since it works. That "something else" then, is probably the Answer_Quote() code, which frankly is one big mess. I'd recommend the following:

USE DUMMY CODE

Try running a dummy macro (a macro that essentially does nothing but open the workbook that should auto-close after some inactivity) instead of Answer_Quote()to see if the problem persists. If it doesn't, then you know for sure that Answer_Quote() is causing the problem. Proceed then to code cleanup.

CODE CLEANUP

1) Set all objects, external file and sheet references to nothing upon exit.

Optionally and thus less importantly, but to ease code maintenance and debugging, I'd also recommend:

2) Use proper and consistent indentation

3) Remove redundant lines of code

For instance:

If wBook Is Nothing Then 'Not open
        Set wBook = Nothing

It is obviously pointless to set a reference to nothing if it is already nothing.

4) Dimension all variables at the top, rather than throughout the code.

5) Use Option explicit (if you don't already)

TEST AUTO-CLOSE EXECUTION

After code cleanup, test again. If the problem persists, try commenting out some of theAnswer_Quote() code and try again. Repeat this process until the auto-close execution works again and you can pinpoint the exact cause of the problem.

Answer 2

try adding a stop statement to your workbook_open to test if the event is even being triggered

Private Sub Workbook_Open()
  start_Countdown
  Stop
End Sub

this would be a brute force way the to run the open Event from the Calling Workbook.

Application.Run(ActiveWorkbook.name & "!Workbook_Open")

add this just after you open the Workbook.