Auto close doesn't quite complete

[picklefactory]

Hi folks. I have a WB that can be opened read only (Password protected to edit) on numerous terminals around our place. I have the following code I use to close it down after 30 mins of inactivity, but it still seems to keep a connection after closing, as when it shuts down via the macro, if I try and open it from another terminal it won't let me in as it shows the previous user as still using it, even though they are not. If they then open any other Excel WB, they then get the password window for this WB, even though it is shut, once they press cancel on that it allows access from elsewhere.
Have I missed something in my code please and maybe not closing it fully?


This section in 'This Workbook'

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:30:00")
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=True
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=False
 End Sub
 
 Sub ShutDown()
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Saved = True
        .Close
    End With
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    Call StopTimer
    Call SetTimer
End Sub

And this section in a module

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:30:00")
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=True
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=False
 End Sub
 
 Sub ShutDown()
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Saved = True
        .Close
    End With
End Sub

 

[Jimmypop]

I'm not sure I want to use Application.Quit as we might have more than one WB open, and that will close all of them.

Maybe use the below to check for other open workbooks?

Sub ShutDown()
    Application.DisplayAlerts = False
    If Application.Workbooks.Count = 1 Then
        With ThisWorkbook
            .Saved = True
            .Close
        End With
        Application.Quit
    Else
        MsgBox “Other workbooks are still open”
        Exit Sub
    End If
End Sub

Else I am not sure why it is not closing properly and keeps on asking for the password?

Maybe someone else reading this thread has a suggestion on what we are missing?

 

[picklefactory]

Thanks again Jimmypop, I'm stuck on another job just now, but I'll get back on this when I can later.

 

[picklefactory]

I've been testing again this morning and I think the Application.Quit does indeed close the file fully. If I take that out I constantly get the Password to open request a minute or so after it closes, and whilst that message box is on screen, it locks the file out from any other user. It happens either when closing manually or via the OnTime event. It doesn't come back with Application.Quit. Strange that the basic WB close code doesn't fully close the file, unless there is another means of closing that I haven't found yet.
I've also just noticed, I have another WB that does exactly the same thing for the same reason, so it's not specific to this WB either.
Odd..... or my coding is just pants

 

[picklefactory]

Current working in Module

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:10:00")
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=True
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=False
 End Sub
 
 Sub ShutDown()
    Application.DisplayAlerts = False
    
    Call EditLog
    
    ActiveWorkbook.Save
    
    With ThisWorkbook
        .Saved = True
        .Close
    End With
    
    Application.Quit
      
    End Sub

Function LastAuthor()
LastAuthor = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
End Function

Function LastModified() As Date
   LastModified = ActiveWorkbook.BuiltinDocumentProperties("Last Save Time")
End Function

Sub EditLog()

    Worksheets("EDIT LOG").Visible = True
    Worksheets("EDIT LOG").Select
    Range("A2").Select
    Do While Not ActiveCell = ""
    ActiveCell.Offset(1, 0).Select
    Loop
    
ActiveCell.Value = LastAuthor()
ActiveCell.Offset(0, 1).Value = LastModified()
        
    Sheets(Format(Now, "mmmm")).Activate
    
    Worksheets("EDIT LOG").Visible = False

End Sub

And current ThisWorkbook

Private Sub Workbook_Open()
    Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)

'    Worksheets("EDIT LOG").Visible = True
'    Worksheets("EDIT LOG").Select
'    Range("A2").Select
'    Do While Not ActiveCell = ""
'    ActiveCell.Offset(1, 0).Select
'    Loop
    
'ActiveCell.Value = LastAuthor()
'ActiveCell.Offset(0, 1).Value = LastModified()
        
'    Sheets(Format(Now, "mmmm")).Activate
    
'    Worksheets("EDIT LOG").Visible = False
    
'    Call StopTimer
    
    Call EditLog
    
    ActiveWorkbook.Save
        
    With ThisWorkbook
        .Saved = True
        .Close
    End With
    
    Application.Quit
 
    
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    Call StopTimer
    Call SetTimer
End Sub